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1, INTRODUCTION 


This final report discusses efforts made on a study 
over the last nine months which had as its primary objective 
the development of techniques to determine the environmental 
effects from the Space Shuttle SRB. exhaust effluents. This 
determination required the blending together of a team which 
had diverse skills and capabilities. The study required 
personnel with experience and knowledge in propulsion chem- 
istry, meteorology, computer- technology ,. and fluid dynamics. 
The study utilized four different computing systems; the NASA 
REEDA, the NASA UNIVAC 1108, the NASA IBM 360,' and the SAI 
IBM 370. Knowledge of their operating systems and details 
of similarities and differences between the machines' data 
storage, instructions, and peripheral equipment operations 
was required during the study. Intimate knowledge of meteo- 
rological data reduction methods was a necessity. The 
start of the development of the new cloud rise model required 
expertise in fluid dynamics. To obtain the source terms for 
the cloud rise calculations required a state-of-the-art 
analysis of the SRB and its exhaust effluents. 

This study has developed many new and needed tools 
for the determination of the environmental effects from the 
Space Shuttle SRB exhaust effluents. A preliminary clima- 
tological assessment has been performed which will be used 
to guide the future full scale climatological assessment. 

The exhaust effluent chemistry study has been performed and 
the exhaust species have been determined neglecting several 
possibly important effects. A reasonable exhaust particle 
size distribution has been constructed which can be used 
for the deposition model. The effects of scavenging and 
absorption have not been included in the preliminary clima- 
tological assessment. The basic conclusion that can be 
drawn regarding the entire study is that the team has now 
done their homework, understands the complete problem more 



fully, has developed the required algorithms, learned the 
required technology, and is now able to perform a meaningful 
climatological assessment with the operational REED Description 
which can yield the required answers about the environmental 
effects from the Space Shuttle SRB exhaust effluents. ' These- 
algorithms have not been interfaced into the REED Description. 

Section 3 on the exhaust chemistry and Section 6 
on ‘the numerical cloud rise model are efforts funded under 
NASA Contract NAS8-31851. The partial results have been in- 
cluded in this report so that a reader can get a clear picture 
of the overall effort. It should be noted that the basic 
studies have been conducted with a Titan type vehicle having 
all solid propellant motors and not the Space Shuttle type 
vehicle which has both solid and liquid propulsors. The tech- 
nology for the problem has been learned but the models must be 
tuned for the Space Shuttle and its unique characteristics. 

This study performed and used the results of a pre- 
liminary climatological diffusion assessment to define the 
problems involved in performing a full scale assessment; there- 
fore, these preliminaify gj-^ qualiHy rdsultfs should be used with extreme 
oautian in drawing oonatus-ions regarding the environmental effects' 
of the Space Shuttle exhaust effluents. 



2. CLIMATOLOGICAL ASSESSMENT 

Environmental impact evaluation will be based on 
calculations of the ground level concentrations using the 
NASA/MSFC ftocket Exhaust Effluent Diffusion (REED) Descrip- 
tion (1,2) input data for each selected meteorological regime. 
The use of the REED Description for environmental assessment 
requires a detailed knowledge of the surface mixing layer. 

The thermodynamic and kinematic properties of this layer can 
be measured with radiosondes, tetroonsonde , and other instru- 
mental platforms. Large samples of these data are required 
for a climatological assessment of environmental impact. The 
only data set available which is sufficiently large to satisfy 
this requirement was obtained from radiosondes. These data 
were obtained daily (at OOOOZ and 1200Z) at KSC for more than 
fifteen years by the U.S. Air Force Air Weather Service. In 
addition, four soundings per day were taken during a five year 
period (1962 through 1966). 

The tapes containing the radiosonde data will be 
scanned and subsets of profiles will be established which 
correspond to the various meteorological regimes that were 
developed for air quality assessments by Stephens and Sloan 
(3). These data subsets will ultimately be used as input to 
the REED Description for calculation of air quality impact. 

The data to be used will be the KSC soundings from 
(*) 

the period 1962 - 1966^ ' . The sample cumulative probability 
distribution of maximiim ground-level concentrations attributed 
to each meteorological regime will be calculated; these 
probability distributions will be useful for estimation of 
the probability of exceeding a specified maximum concentration 
for a particular regime. 


(♦) 


The data tapes were obtained from the U.S. Air Force Range 
contractor. Pan American World Airways. 
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2.1 SELECTION OF AVERAGE YEAR 

Monthly average surface data during the subject period 
(1962 through 1966) were used for determination of the year which 
was most representative of normal conditions at KSC. Because of 
the convenience of obtaining the required summaries from regular 
NOAA weather stations, climatological data from a similar coastal 
location (Daytona Beach) 50 miles from KSC were used to represent 
KSC. 


The criterion for selection of a particular year was 
that it have the smallest value of the parameter D given by 


D = 1/12 


12 

S I 

i=l 


Mi 


12 

^ I 

i=l 


mi 


12 

+2 Iv 1 

i=l mi 


where i=l corresponds to January, i=2, February, etc. and 
It'.,. I, |T'_. I and |v' .| are the absolute deviation of the 
monthly mean daily maximum and minimum temperature and monthly 
mean wind speed from their respective normal monthly means; 
the quantity D represents the average monthly total absolute 
deviation for the three parameters. 


The calculated values of D are given in the table below. 

Year 62 63 64 65 66 

D 4.85 5.30 4.83 3.41 3.65 


Thus, the year 1965 was selected as the year most representative 
of normal conditions at KSC. 

In connection with our selection of a climatological 
data set, the following background data for KSC were acquired 
from the National Weather Records Center: 

• Monthly and annual inversion statistics for 

the period 1965 through 1969 based on KSC Rawin- 
sonde data 

• Monthly and annual STAR summary of atmospheric 
stability for the period 1965 through 1969 based 
on Cocoa Beach surface data 
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• Monthly and annual mixing height statistics for 
the year 1965 based on KSC Rawinsonde data 

With regard to the 1965 KSC Rawinsonde data tape, we 
intend to calculate the following statistics as a function 
of time of day : 

• Distribution of atmospheric stability calculated 
between 1.2 to 1.5 km (4,000 to 5,000 ft) by 
taking the gradient of virtual potential 
temperature 

• Distribution of the height of ground based 
inversions 

• Distribution of wind speed at 1.2 km 

• Distribution of wind direction at 1 . 2 km 

These statistics are correlated with the diffusion 
potential of the ambient air at typical SRB cloud stabilization 
altitudes. The distribution of the height of ground based 
inversions is useful in the study of how often SRB clouds 
are expected to penetrate such inversions and thus become 
effectively isolated from the ground; ground based inversions 
are also responsible for the largest concentrations observed 
at ground level whenever there is a release from a non- 
buoyant ("cold") source. The distribution of wind direction 
at the typical height of SRB cloud stabilization chosen 
(1.2 km) is correlated with the expected track of the SRB 
cloud at the calculated stabilization height. 

r 

2.2 METEOROLOGICAL REGIMES 

In support of air quality assessments for aerospace 
vehicle exhaust effluents at Kennedy Space Center, meteorol- 
ogical regimes were defined which correspond to synoptic 
patterns (3). These regimes are designed to narrow the air 
quality statistics into categories that reflect temporal 
development of atmospheric conditions at launch. 
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In the past the meteorological inputs to the NASA/ 

MSFC REED Description have been based mostly on climatological 
statistics until about 12 hours prior to launch, at 
which time a deterministic forecast was made. An obvious 
drawback to this approach is that the statistical air quality 
assessment during the pending launch period, two or four days 
prior to launch, does not reflect atmospheric dynamics 
identifiable from current synoptic conditions. 

Thus, the purpose of defining meteorological regimes 
in terms of synoptic conditions is to provide a realistic 
means of classifying subsets of the overall climatological 
data set for statistical air quality assessments. Since 
these subsets are more representative of developing atmospheric 
conditions during the pending launch period, the use of these' 
subsets assures a smoother interface of the statistical air 
quality assessment with the deterministic assessment. Employing 
this classification system, the statistical assessment affords 
error bounds for the deterministic predictions. 

It is necessary to consider the types of atmospheric, 
data sources and the applications for which the results of the 
diffusion predictions will be utilized in order to define 
appropriate meteorological regimes. The amount of detail re- 
quired in the atmospheric kinematics is dictated by the planned 
application of the diffusion prediction. Two extremes in , 
applications are air quality and deployment predictions. If, . 
the diffusion predictions are to be utilized in support of 
air quality predictions to insure public safety, the detail in 
the atmospheric input parameter can be relaxed in favor of 
slightly conservative values which incorporates a safety 
factor. Since the desire is to identify any potential for 
an air quality problem, the exact location and concentrations 
are of secondary importance as long as the error bounds for 
these estimates have been determined and are reasonably 
conservative. For this application, routine radiosonde data 
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are satisfactory since small spatial and temporal changes 
in the atmospheric kinematics can be neglected without a 
serious impact on the creditability of the results. 

On the other hand, if the application for the 
diffusion prediction is to support the deployment of the cost- 
effective rocket effluent monitoring network, the resolution 
requirements of the atmospheric input parameters for the REED 
Description are very stringent. This increase of rigor is 
introduced by the need for exactness in the predicted transit 
path. . In this case, local spatial and temporal changes in 
the atmospheric kinematics must be considered. This means 
that terrain effects and the land-sea interface effects must 
be known. Since the radiosonde provides predominately 
vertical information, other sources of data must be used to 
obtain horizontal-temporal information. In general, wind 
tower data are not adequate to totally support this require- 
ment since the available information is limited to the surface 
boundary layer. Currently, the best source of local spatial - 
temporal information is a tetroonsonde (a constant level 
balloon with radiosonde) flown nominally at 600 meters (4). 
Other potential means to obtain or improve the local spatial - 
temporal information would be from simultaneous multiple 
radiosonde releases or a remote sensing system. Hence exact- 
ness in predictions of the exhaust cloud transit path is 
limited by the state-of-the-art of the available small scale 
atmospheric measurement system. Extensive meteorological 
support of the NASA rocket exhaust effluent prediction and 
monitoring program have been documented for a series of seven 
Titan launches (5-11); the hydrogen chloride measurements for 
the same series are described by Gregory, et al. (12) 

A common requirement for a diffusion prediction is 
the statistical air quality assessment for planning activities 
prior to a launch. The objective is to use these statistical 
assessments for mission planning activities to optimize launch 
windows . 
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Meteorological regimes needed for air quality assess- 
ment prior to launch were defined. The regimes were not 
intended for detailed launch effluent monitoring support. 

Before defining the meteorological regimes, 
consideration of the selection and sequential nature of the 
approach will be described. Typically, there are about nine 
different patterns that could be associated with the weather 
conditions at Kennedy Space Center. Within each pattern, 
there are a wide variation in the small scale kinematic and 
thermodynamic structure depending on the type and intensity 
of the mesoscale activity present. 

It is appropriate to use existing knowledge of 
seasonal variation at KSC in the selection of seasonal time 
regimes for statistical analysis. It is apparent that the 
length of the seasons at KSC are non-uniform with relatively 
long summers and winters (mid-May through mid-October and 
December through March, respectively) which are separated by 
short (approximately 6 weeks) transition periods. It is 
known that the summer and winter diffusion meteorology will 
contribute to the largest variation between calculated 
seasonal environmental impacts; since the realistic seasonal 
breakdown of data sets increases the size of the winter and 
summer sample it follows that the comparison of winter and 
summer will have better statistical reliability. 

The approach is to start with the statistical air 
quality assessment that is normally used in the mission 
planning activities; initially the seasonal-temporal regimes 
are defined; that is, the season of the year--winter , spring, 
summer, or fall — and the time of day — night, morning, afternoon, 
or evening. Further narrowing of the regime categories will 
be achieved by sub-division into the following synoptic patterns 

• The Bermuda anticyclone and associated easterly 
winds . 
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• Easterly waves and associated strong vertical 
mixing . 

• Westerly waves and associated frontal activity. 

• Continental anticyclones and associated northerly 
winds . 

The next step in the process is the qualification of 
the intensity of the synoptic regime according to nominal "weak" 
and "strong" categories. Objective criteria will be established 
for such a qualification. i 

In summary the regimes established will consist of the 
following categories: 

• Season 

• Synoptic regime 

• Intensity of synoptic regime 

• Time of day 

Other regime categories such as thermodynamic or kinematic 
parameters may be better suited for climatological air quality 
assessments . 


2.2.1 Air Quality Impact and Associated Meteorological 
Patterns 

Air quality impact can be classified according to 
concurrent synoptic meteorology patterns and air mass types. 

The relative frequency of occurence of these patterns during 
1965 at KSC has been calculated. NOAA synoptic charts drawn 
twice daily (1 a.m. and 1 p.m. EST) were used for the analysis. 
The following synoptic and air mass classification was used: 


Synoptic 

Type 

A 

B 

C 

D 


Synoptic Class 
Maritime Anticyclone 
Easterly Wave 
Westerly Wave 


Continental Anticyclone 


Air Mass 

Maritime Tropical (MT) 

Maritime Tropical (MT) 

^^^Maritime Tropical 

Continental Polar (P) 
Transition (MT-CP) 

Continental Polar (CP) 


^ ^Specification of the air mass type for Type C is dependent 

on the type and strength of the front (cold, warm, stationary) 
and its location relative to KSC. 
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This classification is essentially the same as that 
given in Reference 1 with slight modification of synoptic 
Type A to represent the general category of maritime anti- 
cyclones which is composed of two seasonal sub-types. In 
summer the maritime anticyclone is synonymous with the 
Bermuda anticyclone which persistently dominates the weather 
in the Eastern United States. The only break in this persistent 
pattern occurs in late summer when inverted low pressure 
troughs embedded in the tropical easterlies move to the vicinity 
of KSC (Type B, Easterly Wave). These troughs are in rare 
instances associated with a hurricane. In winter, anticyclones 
containing cold dry air move southeastward toward KSC; as 
these circulations pass over the relatively warm water east 
of the Florida peninsula, they are rapidly modified. Thus, 
in winter, there is a typical alternating pattern of Type A 
and Type D anticyclones. The transition between the two types 
is characterized by Type C (Westerly Wave) conditions which 
include clouds and precipitation associated with fronts and 
eastward propagating waves in the westerlies (Type C, Westerly 
Wave ) . 

The monthly and annual percent occurrence of the 
various synoptic regimes and air mass types during 1965 is 
given in Table 2-1. It is clearly indicated that the pre- 
dominant synoptic regime is the maritime anticyclone (Type A) 
with an annual occurrence of 57.6 percent; on a monthly basis 
Type A predominated during the period March through November. 
During the winter months (December through February) conti- 
nental anticyclones are often strong enough to penetrate far 
enough southward to become the predominant synoptic Type D at 
KSC. The occurrence of air mass types is correlated with 
the occurrence of the synoptic types. 

It is obvious from the analysis that the summer 
season is the most critical in the assessment of environmental 
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Table 2-1. Percent Occurrence of Synoptic and Air Mass Types 
at Kennedy Space Center During 1965 


CO 

I 

CO 



Jan . 

Feb . 

Mar . 

Apr. 

May 

June 

1 July 

Aur. 

Sept.' 

Oct . 

Nov . 

Dec . 

Annual 

Synoptic Type 
A 

27.4 

35.7 

43.5 

66.7 

88.7 

90.0 

90.3 

86.8 

60.3 

37.1 

43.3 

19.7 

57.6 

B 

0 

0 

0 

0 

0 

0 

6.5 

6.6 

20.7 

8.1 

0 

0 

3.4 

C 

14.5 

19.6 

30.6 

6.7 

1.6 

6.7 

3.2 

6.6 

19.0 

29.0 

21.7 

26.2 

15 . 4 


58.1 

44.6 

25.9 

26.7 

9.7| 

3.3 

0 

0 

0 

25.8 

35.0 

54.1 

23.6 

Air Mass Type 
CP 

58.1 

48.2 

29.0 

20.0 

4.8 

0 

0 

j 

0 

0 

22.6 

20.0 

50.8 

21.1 

MT 

33.8 

41.1 

51.6 

70.0 

88.7 

95.0 

100.0 

100.0 

100.0 

53.2 

55.0 

26.2 

67.9 

CP-MT^^^ 

8.1 

10.7 

19.4 

10.0 

1 

6.5 

5.0 

0 

0 

0 

24.2 

25.0 

23.0 

11.0 


Synoptic Types 

A = Maritime Anticyclone 
B = Easterly Wave 
C = Westerly Wave 
D = Continental Anticyclone 


Air Mass Types 

CP = Continental Polar 
MT = Maritime Tropical 
MT-CP = Transitional Air Mass 



Impact in populated areas west ^of KSC. During this period 
Easterly flow associated with the maritime (Bermuda) anti- 
cyclone will occur during a large percentage of the time. 

During the daytime, the synoptic flow is enhanced in the 
surface layer by the local sea-breeze circulation. As the 
air associated with the sea breeze circulation moves onshore, 
a ground based mixed layer develops. The thickness of the 
mixed layer is a function of the intensity of turbulence 
generated by mechanical interaction of the air with the 
land surface roughness elements and land-to-air heat transfer. 

It is hypothesized that concentrations of SRB effluents may 
occur at ground level locations in areas west of KSC when 
portions of the stabilized SRB cloud are within the sea breeze 
mixed layer. This hypothesis will be tested iii a planned 
study based on the available Sample of Rawinsondes obtained 
during the period 1100 to 1500 EST during the summer months 
(June through September) of 1965. The sub-sample of soundings 
which exhibit a well-developed sea breeze and a mixed layer 
extending above the stabilized SRB cloud will be used as input 
data to the UNIVAC 1108 REED Description. The calculated 
maximum concentrations and dosages will be compared with those 
calculated at times of the year during different meteorological 
regimes and times of the day. If the hypothesis is verified 
for the 1965 data, a more detailed analysis will be initiated 
based on the additional summer soundings that can be drawn from 
the existing data tapes for the year 1962 through 1964 and 
1966. The results of this study will comprise the maximum 
estimated impact, assuming that there are no launch constraints 
based on air quality impact considerations. 

During svimmer nights, the land breeze will tend to 
be minimized, since it is opposed by the large scale synoptic 
flow; it is during this period when the flow is poorly organized 
that the forecasting of SRB cloud trajectory will be the most 
difficult. However, calculated downwind concentrations during 
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the night are not expected to be as large as those during the 
day because of the decreased rate of vertical diffusion 
associated with the tendency of the atmosphere near the ground 
to become neutral or stably stratified during this period. 

The idea that a representative sub-sample of mete- 
orological data can be drawn from a larger sample was tested 
by comparing percent occurrence of synoptic and air mass types 
during 1965 for 102 cases (based on two NOAA synoptic- charts 
per day at 1 a.m. and 1 p.m. EST for one day per week for ,51 
weeks) to that obtained for 726 cases based on twice daily 
data for 363 days. The results of this comparison are given 
in Table 2-2. It is indicated that the statistics of the sub- 
sample in most categories correspond closely to those of the 
parent sample. The only significant deviation is for the' 
occurrence of synoptic Type C which is underestimated in the 
sub-sample. This can be attributed to the fact that Type C 
is a transient phenomena that is not accurately seen by 
weekly sampling. 
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Table 2-2. Percent Occurrence of Synoptic and Air Mass 
Types for the Parent Sample (726 Cases) and 
the Sub-sample (102 Cases) for 1965 at KSC 


Synoptic Type 

Air Mass 

Parent 

Sample 

Sub-Samp 1 e; 



(726 Cases) 

( 102 Cases ) 

A 

MT 

56.2 

59.8 


CP 

0.0 

0.0 


MT-CP 

1.4 

1.0 


TOTAL 

57.6 

60.8 

B 

MT 

3.4 

3.9 


CP 

0.0 

0.0 


MT-CP 

0.0 

0.0 


TOTAL 

3.4 

3.9 

C 

MT 

8.3 

4.9 


CP 

1.9 

2.0 


MT-CP 

5.2 

1.0 


TOTAL 

15.4 

7.8 

D 

MT 

0.0 

0.0 


CP 

19.1 

24.5 


MT-CP 

4.1 

2.9 


TOTAL 

23.6 

27.5 

TOTAL 

MT 

67.9 

68.6 


CP 

21.1 

26.5 


MT-CP 

11.0 

4.9 
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2.3 PRELIMINARY RESULTS cFROM 1969 METEOROLOGICAL DATA 

SPACE SHUTTLE CLIMATOLOGICAL DIFFUSION ASSESSMENT 


A preliminary climatological assessment study was 
begun using 1969 meteorological data and effluent parameters 
given in the Agency Environmental Impact Statement for the , . 
Space Shuttle (13), A sample of 101 soundings (one day 
per week and 2 soundings per day) were generated from a 1969 
met data tape using the met screening progra,m. With the aid 
of the AEC and TVA stability criteria output by the program 
for each sounding, the height of the surface transport l^yer 
was chosen and input cards for the pre-processor were 
assembled. The 101 cases were then run through the multi- 
layer/pre-processor system and the results tabulated. Table 
2-3 shows the two worst cases of the 101 processed. The 
November 16th case is further illustrated in Figure 2-1. Note 
that for January 8, the maximum dosage approaches the critical 
NAS level (2400 PPM-sec) as does the maximum peak concentra- 
tion for November 16 (critical NAS level = 8 PPM) (14). 

Table. 2-3. Summary of Worst Cases from 1969. 

Sample, of 101 Cases ‘ 


Adjusted Cloud 


Vehicle 

Date 

Time 

Model 

Pollutant 

Rise Height 

Space 

Shuttle 

01/08/69 

12Z 

4 

HCl 

979.18 

Space 

Shuttle 

11/16/69 

12Z 

4 

HCl 

1135.57 

Range 

Azimuth 

Bearing 

Max Peak 
Cone . 

Max 

Dosage 

Max Peak 10 Min 
Time Mean Cone. 

261.03 

80.28 

1.522 

2176.083 

1.450 

1062.87 

194.78 

5.034 

719.015 

1.198 
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Figure 2-1. Maximum Predicted (Model 4) Ten-Minute 
Time Mean Ground-Level Centerline HCl 
Concentration (PPM) for a Normal Space 
Shuttle Launch (Rawinsonde Input Data 
for 11/16/69, 12Z). 
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Examination of data obtained from towers at various 
locations at KSC has indicated that surface* temperatures can 
be highly variable. This variability leads to a degree of 
uncertainty in the diffusion calculations, which are usually 
based on data obtained at one location. To illustrate this 
uncertainty the diffusion calculation for the worst case 
maximum centerline HCl concentration (11/16/69, 12 Z) was 
repeated using a revised surface temperature of 0*^C which 
was 7°C colder than the original temperature. This temperature 
difference is within the expected range of variability of 
surface temperatures at KSC. The results are illustrated in 
Figure 2-1 (original calculation, surface temperature = 

7.0°C.) and Figure 2-2 (revised surface temperature = 0.0°C). 

It is shown that the revised maximum concentration increased 
to 6.92 PPM from the original value of 5.03 PPM; the maximum 
dosage increased from 719 to 831 PPM-sec for the revised 
data. It is concluded that surface temperature uncertainties 
in the input meteorological data lead to uncertainties in 
the calculated air quality impact. Other workers have indi- 
cated an uncertainty of as large as a factor of two in the 
diffusion model results, largely attributable to meteorological 
uncertainties. However, field measurements taken after TITAN 
launches (1) suggest a significantly smaller uncertainty 
(10 to 25 percent). 

In view of the uncertainties in the calculations and 
the limited sample of KSC meteorological data uses, the results 
for peak concentration described below are considered very 
preliminary . 

By comparing the peak concentration data to NAS 
standards the following categorization scheme was devised by 
Dr. Stephens for mapping of the results. Future results based 
on a large data sample will use the color categories given 
below: 


Actual height about 2m above surface. 
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Figure 2-2. Maximum Predicted (Model 4) Ten-Minute Time 

Mean Ground-Level Centerline HCl Concentration 
(PPM) for a Normal Space Shuttle Launch (Raw- 
winsonde Input Data for 11/16/69, 12Z Modi- 
fied for Model Sensitivity Test; Surface (16 Ft) 
Temperature Reduced by 7°C). 
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COLOR 

MAXIMUM PEAK CONCENTRATION 
(PPM) 

% ot CASES* 

Green 

< 4.00 

96% 

Yellow 

4.01 to 5.00 

3% 

Orange 

5.01 to 8.00 

1% 

Red 

>8 

6 


* Based on the 101 cases during 1969 at KSC. 
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2.3.1 Air Quality Guidelines 

The climatological air quality assessment of the 
impact of the Shuttle SRB exhaust cloud requires the compar- 
ison of ground-level concentration and dosage predictions to 
air quality guidelines given by the National Academy of Sci- 
ences (NAS), with the exception of industrial standards ap- 
plicable to KSC which assume chronic exposure. There are no 
national standards for the short-term exposures associated 
with aerospace exhaust effluents (Ref 14). A graphical il- 
lustration of how a statistical summary of dosage predictions 
can be compared with an NAS guideline for aerospace appli- 
cations is given in Figure 2-3. The particular NAS guide- 
line used in the illustration is the short-term public limit 
for a 10-minute average exposure (STPL 10) which is 4 parts 
per million (ppm) for HCl with an 8 ppm ceiling. This is 
equivalent to a dosage of 2400 ppm-sec. The cumulative dis- 
tribution of maximum 10-minute dosages (expressed in percent 
of 2400 ppm-sec) predicted, by the NASA/MSFC REED Descrip- 
tion for 101 cases during 1969 is plotted in Figure 
2-3. It is shown that 98 percent of the predicted dosages 
were less than 34 percent of the NAS standard. The largest 
predicted dosage was 2176 ppm-sec (January 8, 1969), which 
was 91 percent of the NAS standard. These results are pre- 
liminary. Additional calculations, based on an up- 
dated diffusion model, the objective methods for specifi- 
cation of the standard deviation of wind azimuth angle (SIGAR) 
and transport layer height, and the large sample of data available 
for 1965 <Kl400 cases) will be made as the study continues. 

Initial indications suggest that the Space Shuttle 
does not have an air quality problem under normal atmospheric 
conditions. However, marginal air quality conditions could 
exist within KSC which could result in a requirement for 
crowd control. 
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PERCENT OF NAS STPL 10 DOSAGE LIMIT 


20 30 40 50 60 70 80 »o »d 

CUMULATIVE PERCENT (<) 


Figure 2-3. 


Cumulative distribution of maximum predicted 
10-minute dosage expressed in percent of NAS 
short-term public limit (STPL). (Preliminary 
result based on 101 cases calculated ’from KSC 
Rawinsonde data at OOZ and 12Z) 


2.3.2 Transport Direction of the Stabilized SRB Cloud 


The statistics of expected transport direction of the 
stabilized SRB exhaust cloud give an indication of the dir- 
rection where significant impact is most probable (assuming 
no meteorological launch constraints with regard to expected 
air quality impact). A preliminary evaluation of the dis- 
tribution of SRB exhaust cloud transport, based on 101 cases 
in 1969, is illustrated in Figure 2-4. The transport 
direction was estimated from Rawinsonde data by taking the wind 
direction at the altitude nearest the cloud stabilization 
height. In more than 70 percent of the cases this altitude 
was within 100 meters of the cloud stabilization altitude. 

For the other cases, examination of the wind direction profile 
did not justify interpolation to obtain a better estimate of 
wind direction. Transport direction is taken as 180 degrees 
plus the wind direction. Thus an east wind (90°) results in 
a westward transport direction (270°). It is shown that the 
transport directions with the largest calculated frequency 
of occurrence (12 precent ) were east-southeast and northwest. 
Further comments on transport direction statistics are re- 
served for forthcoming calculations based on larger data 
samples. The distribution of transport direction at KSC 
will be derived as a function of time of day (0100, 0700, 1300, 
1900 EST) for the 1965 transport directions for each time of , ^ 
day that can be obtained using the 1965 data. 
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_ Figure 2-4. Transport direction at cloud stabilization 
height expressed in percent occurrence. 
Based on weekly Rawinsonde data obtained 
twice daily (OOZ, 12Z) during 1969 
(101) cases). 
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2.4 


NEW OBJECTIVE CONCEPTS 


A portion of this study effort was spent in exploring 
new concepts for the objective analyses of the meteorological 
data. These objective analyses, if proven by theory and test, 
would allow the automatic selection of REED Description para- 
meters. That would lead not only to a large savings in man- 
power but to a better, more uniform treatment of the data. 

2.4.1 Transport Layer Height Determination 

An attempt to develop objective criteria for selection 
of the transport layer height used in the NASA/MSFC Multilayer 
Diffusion Model has been made. Acceptable criteria will permit 
the development of a computer code for the automation of trans- 
port layer height selection. Although an acceptable set of 
objective criteria have not yet been found, preliminary cri- 
teria have been established and are being tested. 

Two sets of criteria listed in Tables 2-4 and 2-5 
were studied. The relative frequency of occurrence of the 
various transport layer categories are also given in the 
tables. In the first set of criteria, outlined schematically 
in Figure 2-5, strong emphasis is placed on the existence of 
stable layers below the cloud. This results in a large number 
of transport layer heights below cloud stabilization height, 
which in effect reduces calculated ground level concentrations 
by reducing the amount of cloud mass which can be diffused down- 
ward. If these stable layers are proven to have a smaller fre- 
quency of occurrence because of inaccuracies of the Rawinsonde 
data or are not related to actual transport layer heights, 
the calculated air quality impact will not be conservative. 

In the present stage of development of our capability to pre- 
dict air quality impact, it is not desirable to use techniques 
that may later be proven unconservative . 

The criteria listed in Table 2-5 will give conservative 
results because emphasis is given to the occurrence of wind 
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Figure 2-5. Typical Temperature Soundings for Various 
Mixing Depth Categories of Transport Layer 
Height Given by Circled Number. 
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Table 2-4. Transport layer height percent occurrence in six 
categories derived from weekly Rawinsondes 
at KSC during 1969. 



CATIiGOllY 

PliUCKNT OCCUnuiONCKS 




1200Z 

(0700 EST) 
50 cases 

ooooz 

(1000 tST) Combined 

51 cases 101 cases 

1 . 

Base of stable layer above cloud; 
no stable layers or invorsions at 
or below the cloud altitude 

10.0 

00 

8.9 

2. 

Top of ground based stable or in- 
version layer in which the cloud 
is immersed 

o 

o 

3.9 

to 

o 

3. 

Base of stable or inversion layer 
in which the cloud is immersed; no 
stable or inversion layers below 

10.0 

11.8 

10.9 

4. 

Top of ground based inversion be- 
neath tlie cloud 

O 

00 

21.6 

34.7 

5. 

Top of ground based stable layer, 
beneath the cloud ' 

to 

o 

21.6 

22.8 

6. 

Base of lowest stable layer beneath 
cloud 

o 

00 

33.3 

20.8 

(A) 

Category 5 is synonomous with category 4 when the 
e.\tending upward from the ground consists solely 

stable layer 
of a temperature 



invorsion . 
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Table 2-5. Transport layer height percent occurrence in five 
categories derived from weekly Rawinsondes 
at KSC during 1969. 


CATEGORY PERCENT OCCURRENCE 



OOZ 

12Z 



1900 EST 

0700 EST 

Combined 


51 cases 

50 cases 


Base of stable layer 
above exhaust cloud 

64.7 

64.0 

64.4 

Top of wind shear 
layer 

19.6 

8.0 

13.9 

Base of wind shear 
layer 

0 

2.0 

1.0 

Top of surface based 
stable layer with 
potential temperature 
gradient > . 0098°C/meter 
extending to altitudes 
>250 meters 

13.7 

8.0 

: 10,9 

Top of stable layer in 
which cloud is immersed 

2.0 

4.0 

9.9 
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shears and stable layers above cloud stabilization height. 

A code has been written which executes the logic 
developed by the H. E. Cramer Co. for selection of the height 
of the surface transport layer; selection is based on criteria 
for the vertical gradient of virtual temperature AT^/Az sum- 
marized below: 

• A ground based inversion is defined if 

AT 

Az > 100m and v > -.0005 °C/m 
A z ' 

• Tlie base of a stable layer at if 

Az = Zg - ^ 100m and 

'^'^v <_ - .005 °C/m 

Az 

where Zg > 

If a ground based inversion exists, the height of surface 
transport layer is specified as the top of the ground based 
inversion; otherwise it is the height of the base of the 
first stable layer above the ground. If the base of the first 
stable layer is above 3000m the depth is set equal to 3000m. 

The code will be used for specification of the surface 

transport layer for the 1965 Radiosonde data (>1400 cases). 

The calculation of transport layer height, H^, will be made 

concurrent with the calculation of the stabilization height, 

H , of the SRB cloud. A criteria will be established to 
s' 

identify cases when calculated downwind concentrations and 
dosages are essentially zero. These cases are associated 
with a very low transport layer height relative to cloud 
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stabilization heights. The criteria would be of the form 


where X would be selected on the basis of a sub-set of dif- 

fussion calculations for various values of H - H . The 

s m 

results of these calculations can be illustrated hypothetically 
as shown in Figure 2-6; based on this hypothetical example X 
would be chosen to be 400 meters. 

The criteria would be used to eliminate trivial cases 
from the large parent sample. 

2.4.2 Bivariate Normal Wind Distribution 

In addition to the other analyses of the 1965 data, a 
study of the theory of the bivariate normal distribution and 
it's use in summarizing the wind statistics at KSC was con- 
ducted. The theoretical equations and derivation supplied 
by O. E. Smith of NASA/MSFC were checked out, and the essential 
equations have been coded. Given the bivariate normal statis- 
tics, the program outputs the following: 

• The distribution of wind direction. 

• The distribution of wind speed given a specific 
direction (15). 

Since the monthly bivariate normal statistics have 
already been calculated for KSC, the programs developed would be 
used as part of our operational forecasting scheme. 

2.4.3 Development of Objective Methods for Estimation of 
Meteorological Input Variables for the Multilayer Diffusion 
Model 

The development of objective methods for the estimation 
of meteorological input variables for the Multilayer Diffusion 
Model requires the following: 
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MAXIMUM DOWNWIND CONCENTRATION 
OR MAXIMUM DOSAGE 



• Establishment of a theoretical basis for the 
method , 

• Development of computer codes for calculation 
of the standard deviation of wind azimuth angle 
over a ten^-minute period (SIGAR) and for specifi- 
cation of height of the transport layer (H^) > 

• Testing the computer codes for a climatological 
data sample, 

• Modification of the preprocessor to include the 
new codes. 

The theoretical basis (16) for the method selected 
for estimating SIGAR is based on solution of equation 


SIGAR = a^/U 


kr(D) 

In z/z^-i(;(RI ) 


( 1 ) 


where 

U 


= standard deviation of the lateral 
component of turbulence (m/sec) 

= mean wind speed (m/sec) 


= roughness length (m) 

,k = Von Karman ' s constant = 0.4 (dimensionless) 


The function of Richardson number, 'f(RI), 


for unstable conditions i 


V (RI ) 

= 2 In j^(l+x)/2 

+ 


-1 

ir/2 


- 2 tan x + 

where x 

= (1-16RI)^ 



In [(l+x^)/2j 

( 2 ) 

(2a) 
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For strible conditions (17) 

= Hh- < 3 ) 


The right side of Equation 1 was derived (16) 
by siibsitution of expressions for and U given below for 
the ratio o^/U. 

(4) 

(5) 


a = n*f(B) 

V 

U = y*/k Tin z/Zq - 4'(RI)] 


where p* is the friction velocity, and the function f(B) is 
accurately approximated by fitting line segments to exper- 
imental measurements of the ratio a^/p* according to, 


f(B) 

2.7 

2.7 + 112( .008+B) 

3.4 - 725.5( .00175+B) 
1.55 + 38.04(B-.0008) 
2.35 + 5.43(B-.029) 


B 

B < - .008 

-.008 < B < - .00175 

-.00175 1 B < .0008 

.0008 < B < .029 

.029 < B 


The Richardson number, RI, is defined by 



RI 


where g 
t 

3z 


g 

t 



p 

acceleration of gravity (m/sec ) 
absolute temperature (°K) 

vertical gradient of potential 
temperature (°K/m) 


(7) 
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-g-- = vertical gradient of wind speed (1/sec) 

The quantity £0 can be expressed as a function of pressure and 
dz 

vertical gradient of temperature according to 

i - II - (tl -0098) 


where P is the pressure in millibars. 


Since available wind measurements are not sufficiently accurate 
for estimation of the denominator in Equation (7), it is neces- 
sary to estimate RI from measiiremehts of the non-dimensional 
s t a b i 1 i 1, y ratio, B . 


B = S. 


tu 


A® 

Az 


(9) 


where, z = the geometric mean height (m) between the top and 
bottom of the layer considered (17) 

U = mean wind speed in this layer, (m/sec) 


The relation (17) between B and is 


RI = B 


■ Inz/z^ - 4'(RI ) r 

4,(RI) J 


where, ij)(RI) = (1-16RI)~^ for unstable conditions 


(}.(RI) = 


7RI 


for stable conditions 


( 10 ) 

( 11 ) 

( 12 ) 
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For stable conditions it can be shown that Equation (10) is 
a quadratic function of the parameter y. 


+ y/7kB'^ - (k+l)/7k = 0 

where , y = (RI ) ^ 

k = ln(z/z^)-l 


(13) 

(13a) 

(13b) 


For unequal real rot)Ls, the root given by the following 
equation will result in physically realistic calculated 
values of 1^1 over the expected range of measured values 
of B. 


y 


1 

14k 



4(k+l) 

7k 


(13a) 


RI = 


y 


2 


An additional constraint is required to assure that 
physically realistic values of RI are calculated for stable 
conditions ; examinat ion of Equation 12 reveals that , a singular- 
ity exists for RI = 1/7. The singularity is eliminated by as- 
suming <i)(RI) = (j)(.137) for RI ^ .137. This constraint is im- 
plemented only in rare instances during extremely stable con- 
ditions. This problem is also evident in adder's nomogram 
(17) for estimating RI from B; the RI scale on the nomogram 
has a maximum value of -.13. 


as 


For unstable conditions Equation 10 can be written 

4 


1-x 


16x^ j^l nz/z^+ . 50864-2 [ ln( 1+x )] -ln( 1+x^ ) +2 tan ^xj 


—2 " 


( 14 ) 


where x is given by Equation 2a. Equation 14 is solved 
by Newton's method. 
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The methodology for calculation of SIGAR can be 
summarized as follows: 

• Calculate B from available tower or Rawinsohde 
data (Equation 9) 

• Evaluate F(B) (Equation 7) 

• Specify z . A reasonable first 

approximation is z == .25m (18) 

‘ * o 

• Solve Equation 13 ('i- 14 (unstable or stable 
conditions) to olUain RI from Equation 11 or 
13a respectively. 

• Calculate SIGAR. from Equation 1. 

Preliminary calculations using Rawinsonde data and 
data constructed for the purpose of comparison with Cramer 
Co. SIGAR values (19) are given in Tables 2-8 and 2-9 
respectively . 


Tatolo 2-6.. 


Calculations of SIGAR using Rawinsonde data 
between the surface and the first standard 
pressure level (1,000 mb) with z = .25m. 


Date 
('69, 12Z, 

0700 

EST) 

SIGAR 

(deg) 

A0/Az 

(°C/]00m) 

U 

(m/sec ) 

1/1 



10.8 

-.075 

13. 

1/15 



7.2 

. 98 

8. 

1/29 



7 . 1 

. 93 

11 . 

2/5 



7.7 

2.38 

3.5 

2/12 



8.0 

1 . 29 

4 . 

('69. OOZ, 

1900 

EST) 




7/7 



16.3 

-.69 

6. 

7/14 



17.2 

-.88 

6. 

7/21 



7.6 

. 83 

4 . 

7/28 



15 . 7 

-.20 

2 . 

8/4 



14.5 

-.90 

14. 
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8.76 

(8.5) 


9.10 

9.38 

(7.5) 

(5.5) 

8.78 

8.95 

(8.0) 

(7.0) 


7-11 


15.65 


12 . 11 


8.73 


8.73 


8.76 


( 10 ) 


(9.5) 


(8.5) 


(8.5) [Note 
3] 


(1) AT measured between 3m and 60m. 

(2) SIGAR is the standard deviation of the wind azimuth 
angle measured over a 10-minute period. 

(3) Very stable conditions cannot occur with KSC with surJn 
large wind spec’ds. 













■\ 

\ 

\ 

\ 

Testing of the computer code for SIGAR using the 1965 
KSC Rawinsonde data has begun. Preliminary results for January 
and February data are summarized in Tables 2-8 and 2-9. 

Table 2-8 indicates that none of the computed values of SIGAR 
were less than 3 degrees, very few were greater than 18 degrees 
and most were between 6 and 9 degrees. Table 2-9 indicates 
that for a particular potential temperature gradient, SIGAR 
increases with decreasing wind speed. Table 2-9 should be 
expanded to cover more wind speed and potential temperature 
gradient intervals as the calculations based on all the 1965 
data become available. 

Table 2-8. Distribution of SIGAR computed from Rawinsonde 
Data (January, February 1965, 239 soundings) 


SIGAR (deg) 
<3 
3-6 
6-9 
9-18 
>18 


Percent Occurrence 
0 

22.6 

48.1 

25.5 

3.8 


Table 2-9. Mean SIGAR (deg) as a Function of Potential 

Temperature Gradient for Two Wind Speed Intervals 



No Data 
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2.5 MODIFICATION TO THE UNIVAC 1108 VERSION OF THE REED 

DESCRIPTION AND THE CLOUD RISE PROGRAM 

In the area of climatological assessment, one of 
the major tools is the NASA/MSFC REED Description (2). In 
the original mode of operation, a pre-processor program was 
required to read the meteorological data and calculate cloud 
rise and cloud location. This process has been automated so 
that the two programs are executed in one job stream. .. Instead 
of punching cards, the cloud rise program builds a disk file 
where each case processed is given a unique identifer., The 
REED program then executes with . the capability of chopsing 
any of the cases from the cloud rise file in any order. Addi- 
tional flexibility is achieved by allowing the user to over- 
ride any parameters set by the cloud rise program prior to the 
execution of the REED Description. 

For the purposes of documentation and compact storage, 
the capability to produce a duplicate copy of all printer 
output on plot paper was added. This plotter output is much 
more suitable than printer output for 8| by 11” documents, and 
is also more easily filed. In addition, the tapes from which 
these plots are made can be saved and used as data files from' 
which additional calculations can be performed. 

Finally, the capability to print a table summarizing 
the most critical parameters for each case in a particular run 
was added to the code. Thus in a. run where many cases are 
processed, the user can quickly determine which cases are the 
more critical. This table can be conveniently used directly 
for documentation purposes. 
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2 . 5.1 


Screening Program Modification 

Modifications to provide additional capabilities 

♦ 

for the Meteorological Data Screening Program were completed. 

The MET Screening reads in cards, which indicate which sound- 
ings to search for, and reads from met data tapes, then it 
generates as output, plots, cards, and printout for each 
sounding processed. 

The plots include a list of the cloud rise heights 
plus the following plots: 

• Wind Speed versus Altitude 

• Wind Direction versus Altitude 

• Dry Bulb and Potential Temperature versus Altitude 

• Temperature, Virtual Temperature, and Virtual 
Potential Temperature versus Altitude 

The card output from the Screening Program is punched 
in the format needed for the pre-processor. 

The printout has been expanded to include stability 
criteria. The data were tested against both TVA and AEC stability 
criteria. The results are printed in a table after the 
original output has been completed for each time. The following 
information is printed: The altitude interval, temperature 

interval, DTODS, AEC stability, potential temperature interval, 
DPTODZ, and TVA stability. DTODZ is defined as 

where i = 1 - no. of altitudes 
T is temperature (*^C) 

Z is altitude (meters) 

PT is potential temperature 




T. 

1 


Ti-l 


- ^i-1 


DPTODZ is defined as 


PT^ - 

- Z. , 
1 1-1 


Initially developed by Dr. Stephens and W. C. Campbell at MSEC. 
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The AEC and TVA stability criteria is listed in Table 2-10. 
This added printout aids in choosing the height of the 
surface transport layers needed for input into the cloud rise 
program. 


Table 2-10. hil ity Criteria 

ATOMIC ENERGY COMMISS IO N CRITEUiA 
X = Gradient of Temperature 

C 1 assi f icat i on X (*^^0/ Me ter ) 


Extremely unstable 


X< 

-.019 

Moderately unstable 

-.019 < 

X< 

- . 017 

Slightly unstable 

-.017 < 

X< 

- . 015 

Nou tral 

-.015 < 

X< 

- . 005 

Slightly stable 

-.005 < 

X< 

. 015 

Moderate! ly stable 

.015 £ 

X< 

. 04 0 

Extremely stable 

.040 < 

X 



TENNESSEE VALLEY AUTHOR ITY 

CRJTJiRl 

Y 

Cl assi f icat ion 

= Gradient of Potential 

Y(0 

Temper 
C /Me ter 

U n s t a b 1 e 


< 

-.0017 

Neutral 

-.0017 

Y£ 

. 00] 6 

Moderately stable 

.0016 

Y< 

. 0070 

Very stable 

.0070 

Y< 

. 0187 

Extremely stable 

. 0187 

< Y 
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2.5.2 


Addition of New Vehicle and Updating of Constants 

The characteristics of the newest solid motor in the 
Thor-Delta family of launch vehicles were added to the Multi- 
layer/pre-processor system. This new vehicle is known as the 
Thor-Delta 3914 and is the fifth vehicle that can be simulated 
by the code. 

In conjunction with determining the values for con- 
stants associated with the 3914, the same constants were ex- 
amined for the other four vehicles. These constants include 
the following: 

• QCl, QC2, QC3 - total source output rates (g/sec) for the 
three types of launch respectively (i.e. normal, abnormal 
with one motor burning on the pad, abnormal where motors 
explode and burn on the ground). 

• QTl , QT2 , QT3 - total source strength (g) for the three 
types of launch respectively. 

• HEATN, HEATM, HEATA - Heat output (cal/g) for the three 
types of launch respectively. 

• a, b, c - Rocket rise parameters in the equation 

T = az^ + c where T is the burn time and z is the altitude 

• FRQl - Fractional distribution of material for HCl, CO, 

COg and AL 2 O 2 . 

Table 2-11 lists the preliminary values determined 
for these constants: 
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Table 2-11. Preprocessor Program Constants 





Vehicle 



Para- 


Space 

Thor-Delta 

Minuteman 

Thor-Delta 

meter 

■■ 

Shuttle 

2914 

II 

3914 

QCl 

5.437528E6 

1.5219230E7 

8.360685E5 

4.684476E5 

1.057557E6 

QC2 

2.718764E6 

6.882968E6 

9.09811E4 

4.684476E5 

1.4829227E5 

QC3 

1.359382E6 

3.441484E6 

2.729434E5 

1.171119E5 

3.70731E5 

QTl 

3.262517E8 

1.894794173E9 

2.887598E7 

2.810686E7 

6.701691E7 

QT2 

1.631258E8 

8.569295E8 

3.14229E6 

2.810686E7 

9.398616E6 

QT3 

3.262517E8 

1.713859E9 

1.885373E7 

2.810686E7 

4.699308E7 

HEATN 

2021.1 

(1969.6)* 

1479.7 

1766.0 

2055.9 

1449.9 

HEATM 

1010.55 

1062.35 

1000.00 

2055.9 

1000.00 

HEATA i 

1000.00 

1000.00 

690.0 

1000.00 

411.18 

FRQl 






-HCl 

.1931 

.1782 

.1218 

.1977 

.1589 

1 

o 

o 

.2665 

.2021 

.2055 

.2380 

.2783 

-C02 

.0222 

.0286 

.0156 

.0318 

.0331 

-AL203 

.2819 

.2524 

.2214 

.2761 

.1936 

AA 

.429580 

.652213 

,922156 

.469982 

1.245756 

BB 

. 518422 

.468085 

.432703 

.463333 

.418095 

CC 

0.375 

5.0 

0.0 

0.0 

0.0 


*Value used in report; other is up-dated reflecting latest result. 
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T_ 

The original rocket rise equation T = az° was modified 
"b 

to the form T = az°+c. The constant c was added to take into 
account the time lapse between ignition and lift-off. The param- 
eters a, b, and c were obtained from least -st^ares fits of em- 
pirical trajectory data. Plots of the trajectories generated 
by the old values and by the new values were made against the 
measured trajectories. The results are shown in Figures 2-7 
through 2-11. For each of the original four vehicles, the tra- 
jectory generated by the new values is closer to the measurement 
than is the did trajectory.' 

Since the burn rate for solid propellant motors is 
influenced by the initial temperature of the propellent, the 
pre-processor program was modified to take into account this 
initial propellant temperature. A table of the mean temper- 
atures at KSC for each month was added to the code. Based on 
the month in which meteorological data was taken, the default 
temperature is obtained from the table and used to compute 
a burn-rate factor (where 70° is the standard, yielding a 
burn-rate factor of one). The capability to over-ride this 
default table was also added to the code, so the initial pro- 
pellant temperature, if known, can be input to the program. 

Various runs were made with the UNIVAC 1108 REED 
Description/Cloud Rise system to check out all the modifi- 
cations made to the code; however no production type runs ha.ve 
been performed. 
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Figure 2-11. 


Delta Thor 3914 Trajectory 
T = az^+c 



2.6 


SURFACE DEPOSITION MODEL 


Three major constituents in the SRB and SSME exhaust 
effluents are AlgOg, HCl, and HgO. The HCl is of prime concern 
environmentally since it is potentially toxic in the gaseous 
phase and forms a strong acid in the aqueous phase. Two 
phases of AlgOg can exist, the gamma phase which reacts strongly 
with HCl and the alpha phase which does not. The HCl 
reacts with and is absorbed by water droplets to form an 
aerosol. The formation of the aerosol, of course, reduces 
the concentration of gaseous HCl in the atmosphere. The 
alumintim oxide absorbs HgO readily; it is used as a drying 
agent in laboratories. Rain falling through a cloud consist- 
ing of the rocket exhaust effluents and the entrained air 
can react chemically with the HCl and possibly the AI 2 O 2 and 
can physically interact with the HCl aerosol and the Al^O^. 

Thus it can be seen that the Al 20 g/HCl/H 20 system has a large 
number of physical and chemical interactions that can occur 
simultaneously. A consistent set of reactions and interactions 
must be developed to allow the calculation of the HCl and 
AI 2 O 3 concentrations for a surface deposition model. 

The phase of the aluminum oxide in the exhaust is 
not without question. Early work (25) indicated that the 
aluminum oxide present in a rocket exhaust is the alpha phase, 
which does not react with HCl. More recent data (26 , 27 , 28 ) has 
indicated that some of the gamma phase may be present . This 
may be important to the surface deposition depending on the 
aluminum particle size distribution in the rocket exhaust. 

The SRB exhaust will have relatively large particles; there- 
fore, the amount of gamma phase will be less than found in 
small motor firings. Of course, for an equal weight, the 
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number and surface area for small particles is greater than 
for larger particles. The whole question of AlgOg phase is 
undergoing intensive investigation and must be considered when 
developing a surface deposition model. 

Using available experimentally measured AlgOg particle 
size distributions (29) for solid propellant rocket motors of 
various sizes and making reasonable assumptions as to particle 
size growth as a function of throat diameter, a particle size 
distribution for the AI 2 O 3 exhausting from the Space Shuttle 
SRB was determined. This is shown in Table 2-12. At the 
present time no realistic input to the REED Description surface 
deposition model is available for use; therefore, these effects, 
which may be significant for climatological predictions, have 
been neglected. 

2.7 ABSORPTION AND SCAVENGING 

Studies have been conducted on atmospheric scavenging 
of HCl which experimentally determined the washout coefficient 
(30,31). Washout involves several microprocesses, including the 
solubility of HCl in raindrops, the diffusion of HCl to the 
falling raindrops, and the physical parameters which character- 
ize the rain. At higher relative humidities, washout of HCl 
aerosol must be considered in addition to the washout of gas- 
eous HCl. The AlgOg particles as well as salt or dust par- 
ticles in the rocket exhaust may act as potential cloud drop- 
let nuclei. The nucleating efficiency of AI 2 O 2 particles 
is unknown at this time. The rain scavenging experimental 
results must be Integrated into the surface deposition model. 

The effects of absorption and scavenging, which may 
be significant for climatological predictions, have been 
neglected in this study because of the lack of a suitable , 
acceptable washout coefficient. (27,30,32,33) 
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Table 2-12 


SRB Particle Size Distribution 


Particle Diameter 
in Microns 

0- 7.0 

7.0-10.0= 

10.0- 14.0 

14.0- 16.0 

16.0- 23.0 


Weight 

Percentage of the 
Particles of that 
Size Range 

20.0 

20.0 

20.0 

20.0 

20.0 
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2.8 


CONCLUSIONS 


The long term objective of this study is to establish 
the relation between weather patterns of various scale and 
the environmental Impact of the Space Shuttle exhaust effluents. 
To date, the synoptic weather patterns have been categorized 
and their relative frequency of occurrence have been calcul- 
ated. 

Concurrently the tools for calculating air quality 
assements for large samples of KSC. meteorological data have 
been developed. A large sample oL Rawinsonde data are 
available for definition of the variability of calculated air 
quality assessments over time scales as small as six hours. 

This variability is associated with such phenomena as the 
development of the sea breeze and ground based stable layers. 
These phenomena strongly influence the critical meteorological 
input variables to the diffusion model. 
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3 . EXHAUST CHEMISTRY 

The calculation of the heat content of the plume, or 
more exactly the heat content of the rocket exhaust effluents, 
taking into account interactions with the ambient environment, 
is a well-defined problem. The problem has been attacked 
for many years by the propulsion community and a set of stan- 
dard techniques have been devised and published for liquid 
engine performance and analysis by the Interagency Chemical 
Rocket . Propulsion Group - Joint Army, Navy, NASA, Air Force, 

( ICRPG-JANNAF) Performance Staindardization Working Group (34, 
35, 36). Thd state-of-the-art of analysis for solid motors 
is not yet as advanced but an ICRPG-JANNAF Solid Performance 
Working Group has begun work. 

The available techniques were adequate for analyzing 
the plume from the liquid propellent SSME rocket engine and 
the solid propellant SRB motors. The value of the effective 
heat release and the exhaust species concentrations were 
quantitatively satisfactory for both propulsion devices. 

During this study only the Space Shuttle SRB exhaust effluents 
were studied in detail , Solid propellant rocket motors have 
the phenomena of two-phase flow occurring in the combustion 
chamber, nozzle, and plume. The two phases are not in thermal 
or velocity equilibrium. In general, the particles, in this 
case solid and liquid aluminum oxide, are traveling slower 
than the gas, are at a higher temperature than the gas, and 
are at a greater flow angle than the gas. These phenomena 
make the characteristics of a two-phase flow field different 
than that of a single-phase flow field such as occurs in the 
liquid propellant SSME. 
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3,1 TWO-PHASE FLOW PHENOMENA - 

The analysis of the two-phase flow in the SRB rocket 
nozzle started with a one-dimensional thermochemical analysis 
of the solid propellant. As seen in Figure 3-1, when solid 
propellant combusts, the combustion products are at some 
pressure, P^ , and some flame temperature, T^ , The chamber 
pressure history is governed principally by the amount of 
burning surface exposed. The desired amount of burning sur- 
face (chamber pressure) can be obtained by the geometry of the 
propellant grain. Figure 3-2 shows the Space Shuttle altitude 
Mach number, and Solid Rocket Motor chamber pressure history . 
for the first 70 seconds of flight. As can be s4en, the 
chamber pressure varies from 825 to 580 psia during this 
portion of the flight. With a knowledge of the propellant 
composition and the chamber pressure, the flame temperature 
and the concentrations of the combustion products were cal- 
culated as shown in Table 3-1. The flame temperature and the 
combustion products as g function of time (velocity and alti- 
tude are then known) were needed for input’ to subsequent steps 
The calculations were performed bn the NASA UNI VAC 1108 with 
a program written by NASA-Lewis -Research Center (38) and 
modified by SAI . ^ ■ 

By means of two-phase characteristic theory, the 

* A 

supersonic portion of the flow field of the SRB nozzle and 
plume was determined. With reference to Figure 3-1, the 
supersonic portion is bounded roughly upstream by the nozzle 
throat and downstream by the plume boundary. The nozzle 
analysis portion of the program- basically terminates calcul- 
ation along the last left-running characteristic, identified 
on Figure 3-1. This surface is significant in that no 
disturbance downstream of it will affect the pressure field 
along the nozzle wall. The program originally written by 
TRW personnel (38) and extensively modified by SAI (40) 
yields vital pieces of information along the last 
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PLUME SHOCK 


UNDISTURBED 
PLUME BOUNDARY^ 



AMBIENT AIR 


/SOLID PROPELLANT^ 

m7/////////m////m. ■ 


SOLID PROPELLANT 
COMBUSTION PRODUCTS 

CO HCi H2O N2 

CO2 H2 AI2O3 NOx 


SOLID ROCKET MOTOR NOZZLE- 


NOZZLE THROAT 


MIXING REGION 


LIMITING—* 
PARTICLE y 
STREAMLINE > 


/V 


LAST LEFT RUNNING CHARACTERISTIC 


One Dimensional 
Thermochemical 
Analysis 


Two Dimensional 
Two Phase 
Nozzle Analysis 


Figure 3-1. Solid Rocket Motor, Nozzle, and Plume 


left-running characteristic which are needed for subsequent 
steps in the modeling. 

A two-phase flow field is dissipative and non-equili- 
brium in nature. There is, therefore, an entropy rise down 
the flow field and an entropy gradient radially across the 
flow fields since the particles and gas have a different 
history at every point in the flow field. The entropy rise 
and the loss in total pressure can be calculated from local 
flow properties. Figure 3-3 shows the total pressure loss 
and gradient along the last left-running characteristic for the 
Space Shuttle SRB nozzle with a single particle size of 12.0 
micron diameter which represents an average particle size. The 
pressure loss varies from about 27 to 55 percent of the chamber 
pressure; thus, the species and energy content of the exhaust 
will vary across the nozzle exit. Because of the wide vari- 
ation in properties across the exit, an integration scheme 
was incorporated into the program which integrates the mass 
flow and energy content and computes the average for a gross 
value of the energy content of the exhaust as it leaves the 
nozzle. The energy content of the exhaust was assumed to 
be composed of two parts: the sensible enthalpy and the 

kinetic energy of the gas. For a SRB operating at 780 psia 
chamber pressure, the average integrated value of the heat 
content of the plume is 2125 calories per gram. Figure 3-4 
is a schematic of the SRB nozzle. The chamber pressure chosen, 
780 psia, is an average value representative of the SRB when 
it is close to the launch pad, 0-3000 meters altitude. 

3.2 AFTERBURNING AND MIXING ANALYSIS 

Solid propellants normally are formulated to have an 
exhaust composition rich in underoxidized species, i.e., the 
carbon, C, is preferentially in the form of carbon monoxide, 

CO, rather than carbon dioxide, CO 2 . This formulation tech- 
nique gives higher specific impulse for the propellant. A 
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Figure 3-3. Ratio of Stagnation to Chamber Pressure vs Radial Dis'tance 
Along Last Left-Running Characteristic 
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jet exhausting into a stationary or moving atmosphere tends 
to entrain and mix the atmosphere with the jet exhaust. 

When a hot exhaust with underoxidized species mixes 
with ambient air, the possibility for afterburning exists. 

This condition has been noted on several launch vehicles, and 
digital computer programs have been written to describe the 
phenomena with varying degrees of success (41-43). Several 
of the programs appear generally suitable for use in the propose 
ed study. Based on such factors as ease of input, accuracy, com- 
puting time, and calculation technique, the program written by 
AeroChem Research Laboratories, Inc. (43) was chosen. Fig- 
ure 3-5 shows the plume afterburning schematic as it applied to 
this situation. The only modification necessary for the pro-' 
gram to be used for the problem under consideration is in the 
description of the the initial data line. The initial data line 
for the original program is assumed to be radial, normal to 
the axis at the exit of the nozzle. All species and the veloc- 
ity at each grid point must be input . The output of the two- 
phase analysis program is along the last left-running char- 
acteristic. The velocity, entropy, and stagnation pressure 
are known at every point on the characteristic but not the 
species; therefore, a technique was devised which would fill 
the gap between the last left-running characteristic and the 
needed initial value line and which would calculate the species 
along the initial value line. There exists in general use in 
the aerothermodynamic community in this country, a computer 
program known as PLIMP (44) which calculates and outputs 
the species concentration, pressure, temperature, and velocity 
fields on surfaces immersed in a plume; therefore, if a flat 
plate is placed normal to the axis at the exit of the nozzle, 
all necessary quantities will be obtained. 

The Aerochem mixing program calculated the required 
values of species concentration and amount of entrained air 
simultaneously. Stedman (27) in his work estimated the 


3-9 


-10 




amount of mixed or entrained air from the work of Hart (45) 
and assumed uniform mixing and chemical equilibrium in the 
cloud. The Aerochem program not only estimated the amount 
of entrained air, which is not uniform across the jet, but 
also determined the species concentrations using finite-rate 
chemistry. This , technique thus detailed the species, the 
reaction rates, and the temperature and pressure radially 
across the exhaust as well as in a downstream direction from 
the nozzle exit. -An inventory of the constituents was thus 
maintained. Table 3-2 lists the reaction scheme utilized' in 
this study. The scheme models the chlorine species production 
and destruction in detail. Figures 3-6 and 3-7 show the Space 
Shuttle' SRB exhaust effluents as a function of distance from 
the nozzle exit. Table 3-3 shows the exhaust effluent weight 
fractions as a function of distance from the nozzle exit. ' 

3 . 3 OTHER LOSSES 

It should be noted a number of potentially important 
effects were neglected. The first effect neglected was the 
injection of water into the exhaust. Since the study was 
initiated, the decision was made to inject large quantities 
of water into the exhaust as a noise suppression technique. 

The water is not only to be injected when the Space Shuttle is 
sitting on the launch pad but the injection will continue until 
it clears the launch pad. Due to the afterburning and the 
large number of hot particles, a large luminous plume is 
formed; therefore, radiation losses may be important. Hart 
(45) using geometric flight and launch hardware radiant flux 
estimates, states that the radiation loss may be as large as 
one-fourth the total heat content. If this estimate is correct, 
radiation loss calculations are imperative. The radiation 
data for the exhaust effluents have been collected and tab- 
ulated, but the entire calculation has not yet been performed. 
During the time the SSME's are building up thrust and until 
shortly after SRB ignition, the Space Shuttle is held onto 
the launch pad. During this time and even after liftoff, for 
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Table 3-2 

AFTERBURNING ANALYSIS 

REACTIONS BEING CONSIDERED 


1. 

HCL 

+ 

OH 


= H20 

+ 

CL 

20. 

H 

+ 

HO 2 


= OH 

+ 

OH 

2. 

H 

+ 

HCL 


= CL 

+ 

H2 

21. 

H 

+ 

02 

+ M 

= H02 

+ 

M 

3. 

OH 

+ 

CL 


= HCL 

+ 

0 

22. 

0 

+ 

H2 


= OH 

+ 

H 

4. 

CL 

+ 

H02 


= HCL 

+ 

02 

23. 

0 

+ 

HO 2 


= OH 

+ 

02 

5. 

CLO 

+ 

OH 


= H02 

+ 

CL 

24. 

OH 

+ 

HO 2 


= 02 

+ 

H20 

6. 

H 

+ 

CL2 


= HCL 

+ 

CL 

25. 

H2 

+ 

HO 2 


= H20 

+ 

OH 

7. 

0 

+ 

HCL 


= CL 

+ 

OH 

26. 

H 

+ 

OH 

+ M 

= H20 

+ 

M 

8. 

CL 

+ 

03 


= CLO 

+ 

02 

27. 

H 

+ 

H02 


= H2 

+ 

02 

9. 

CL 

+ 

CL 

+ M 

= CL2 

+ 

M 

28. 

OH 

+ 

H2 


= H20 

+ 

H 

10. 

0 

+ 

CL 

+ M 

= CLO 

+ 

M 

29. 

N 

+ 

02 


= NO 

+ 

0 

11. 

CLO 

+ 

H 


= HCL 

+ 

0 

30. 

NO 

+ 

0 

+ M 

= NO 2 

+ 

M 

12 . 

0 

+ 

CLO 


= CL 

+ 

02 

31. 

NO 

+ 

CLO 


= CL 

+ 

N02 

13 . 

H 

+ 

CL 

+ M 

= HCL 

+ 

M 

32 . 

NO 

+ 

03 


= N02 

+ 

02 

14. 

03 

+ 

0 


= 02 

+ 

02 

33. 

N02 

+ 

H 


= NO 

+ 

OK 

15. 

0 

+ 

0 

+ M 

= 02 

+ 

M 

34. 

N 

+ 

NO 


= N2 

+ 

0 

16 . 

0 

+ 

H 

+ M 

= OH 

+ 

M 

35 . 

CO 

+ 

OH 


= C02 

+ 

H 

17 . 

H 

+ 

H 

+ M 

= H2 

+ 

M 

36 . 

CO 

+ 

0 

+ M 

= C02 

+ 

M 

18 . 

OK 

+ 

OH 


= H20 

+ 

0 

37 . 

CO 

+ 

H02 


= C02 

+ 

OH 

19 . 

H 

+ 

02 


= OH 

+ 

0 

38. 

NO 

+ 

CLO 


= CL 

+ 

NO 2 


SPECIES CONCENTRATIONS (PPM) 



Figure 3-6. Space Shuttle Solid Rocket Motor Exhaust Effluents 
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Figure 3-7. Space Shuttle Solid Rocket Motor Fxhaust Effluents 




Table 3-3 


Space Shuttle SRB Exhaust Effluents 
Concentrations in Weight Percent 


Effluents 

Distance From Nozzle Exit - Feet 
0 1000 2000 3000 

^^2^3 

30.32 

22.56 

22.36 

22.43 

CO 

24.36 

0.052 

0.052 

0.052 

COg 

3.33 

30.85 

30.58 

30.67 

Cl 

0.246 

0.013 

0.008 

0.007 

CIO 

0.006 

0.000 

0.000 

0.000 


0.008 

1.60 

1.59 

1.60 

HCl 

21.41 

14.18 

14.06 

14.10 

«2 

2.09 

0.000 

0.000 

0.000 

H 2 O 

9.39 

21.43 

21.24 

21.30 

^2 

8.78 

8.26 

8.13 

8.22 

NO 

0.001 

0.989 

0.980 

0.982 

°2 

0.004 

0.000 

0.000 

0.000 
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a short time, the exhaust effluents are flowing into the 
flame trench where they are mixed with a large amount of water 
and ducted away. This mass and energy ducted away represents 
a possible loss to the ground cloud which may be important . 
This portion of the problem has not yet been attacked. This 
study has concentrated primarily on the SRB exhaust effluents 
and has essentially neglected the SSME exhaust and the problem 
of the impingement and mixing between the SRB and SSME exhaust 
plumes. The SSME exhaust effluents have been calculated and 
are shown in Table 3-4. 

3.4 CONCLUSIONS 

This study has developed a technique that allows 
the exhaust effluent chemistry for the SRB to be determined 
with a state-of-the-art analysis. At this point the basic 
exhaust effluents have been calculated but a number of im- 
portant losses such as plume impingement, radiation, flame 
trench, and water injection have not been addressed. The 
effluents from the SSME have been determined but the chemical 
and physical interactions between the two plumes has not been 
studied. 
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Table 3-4 


SSME Exhaust Effluents 

Engine Conditions 

= 3000 psia 

0/F = 6 

kjk. = 77.5 
e' t 


Species 

Location in Engine 

Chamber Throat 

Concentrations in Mole 

Exit Plane 
Fractions 

H 

0.0270 

0.0217 

0.0000 

^2 

0.2477 

0.2450 

0.2440 

H 2 O 

0.6831 

0.7026 

0.7560 

0 

0.0024 

0.0015 

0.0000 

OH 

0.0373 

0.0276 

0.0000 

°2 

0.0026 

0.0017 

0.0000 







4 . CONVERSION PROGRAMS 

In order to allow for the processing of various types 
of data, received from numerous sources (i.e., Marshall Space 
Flight Center, Kennedy Space Center, Vandenberg AFB, Point 
Mugu, Asheville, etc.) and generated on several different 
computer configurations (i.e., IBM 360, IBM 370, IBM 7094, 

UNIVAC 1108, CDC 3300 etc.); there becomes a specific need 
for software which provides the capability of converting the 
various and voluminous amount of data into the proper BCD/ 
EBCDIC-*-ASCII character set and record format to make it com- 
patible to the different computer systems (i.e., IBM, UNIVAC, 

REEDA), upon which the data will be processed by a variety 
of programs. The data and programs must be available on all 
NASA/MSFC machines since no machine outage should cause a lack 
of monitoring capability. 

In this section various conversion programs that were 
developed are discussed. Section 4.1 describes the conversion 
programs which have generic applications while Section 4.2 
discusses conversion programs developed for individual cases. 

The program listings are given in the Appendix. 

4.1 CONVERSION PROGRAMS (GENERIC) 

The most efficient means to load data or software on the 
REEDA System, which was generated on other computer configurations, 
is to generate a magnetic tape compatible with the REEDA System. The 
following is a list of the requirements that all magnetic tapes must 
satisfy to be usable on the REEDA System: 

• 9-track magnetic tape 

• 800 bits per inch 

• Odd parity 

• 7-bit ASCII (The 8th bit is always off; this limits 

the character set to 128 combinations) 

however, most (if not all) of the data and software programs 
being processed on the REEDA System received from other computer 
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installations were recorded on magnetic tape in a format not 
compatible with the REEDA System. Thus, various conversion 
programs were generated to convert data recorded on IBM, 
UNIVAC, CDC, etc,, computers to a usable format. 

4.1.1 IBM 370/360 BCD ->• ASCII Conversion Programs 

A conversion program was developed to convert data or 
programs recorded in BCD (on cards or magnetic tape) to a 
usable REEDA System ASCII character set. This program is 
written in IBM assembly language and will execute on either 
the IBM 370 or 360 configuration. It will accept as input 

either a 7-track or 9-track tape, or punched cards and convert 
each BCD character into a 7-bit ASCII character compatible 
with the REEDA System. This converted data is written onto a 
magnetic tape for REEDA utilization (i.e., 9-track, 800 BPI, 
ODD parity). An example flow of the conversion process is 
given in Figure 4-1. Note, only the control cards change when 
running this program on the IBM 370 or IBM 360. 



Figure 4-1. IBM 370/360 BCD ASCII Conversion 
Process 
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4.1.2 IBM 370/360 EBCDIC -> ASCII Conversion Programs 

A conversion program was developed to convert 
data or programs recorded in EBCDIC (on cards' or magnetic tape) 
to a usable REEDA System ASCII character set. This program 
is identical to the BCD -> ASCII conversion program except all 
EBCDIC characters are converted to ASCII. As shown in Figure 4-1, 
input can be either cards or magnetic tape with the output 
being a REEDA compatible 9-track ASCII tape. Once again only 
the control cards change from the IBM 370 and IBM 360 programs. 

4.1.3 U NIVAC ^ 1108 BCD ->- ASCII Conversion Program 

A conversion program was written in UNIVAC assembly 
to allow for the conversion of BCD record data on the UNIVAC 
1108. As with IBM conversion, data is accepted from either 
cards or 7-track or 9-track magnetic tape. Each character is 
then converted to the corresponding 7-Bit ASCII character. A 
REEDA System compatible 9-track ASCII tape is generated as 
shown in Figure 4-2. 



Figure 4-2. UNIVAC 1108 BCD ASCII Conversion 
Process 
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4.1.4 


UNI VAC 1108 EBCDIC ->■ ASCII Conversion Program 


A conversion program was also written in UNIVAC 
assembly language to allow for the conversion of EBCDIC recorded 
data on the UNIVAC 1108. This program is identical to the BCD 
^ ASCII conversion program except all EBCDIC characters are con- 
verted to ASCII. As shown in Figure 4-2, input can be either 
punched cards or magnetic tape with the output being a 9-track 
ASCII REEDA compatible tape. 

4.2 CONVERSION PROGRAMS (SPECIFIC) 

All of the generic BCD/EBCDIC conversion programs 
allow data to be converted from card/tape to REEDA System 
compatibility in a one-pass operation. However, the conversion 
programs were developed with a prerequisite that all data records 
be 80 characters long (i.e., card size). Thus, in the event 
records being converted (from tape) are not card images, that is, 
longer or shorter than 80 characters, a pre-processor is needed 
to reformat the data into 80 character records. This data can 
then be used as input into the BCD/EBCDIC conversion programs 
as shown in Figure 4-3. 



Figure 4-3. Reformatting to 80 Character Records 
Then Converting BCD/ECBDIC ^ ASCII 

Here the reformatter programs were developed to reformat 
various data from KSC , JSC, Pt . Mugu, Vandenberg AFB, etc., 
generated on IBM 7094, IBM 360, CDC 3300, UNIVAC 1108, etc., 
computers to REEDA compatibility. These programs are discussed 
in Chapter 5. 
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4.2.1 


HP EBCDIC ASCII Conversion Program 


A conversion program was written in HP assembly 
language to translate IBM 9-track, ODD parity, EBCDIC recorded 
tapes to the compatible HP format. The program is capable of 
converting all IBM EBCDIC characters into their 7-Bit ASCII 
equivalent. Each 32 bit IBM integer is translated to a 16 
bit HP integer, and 32 bit IBM real numbers are translated 
into the HP 32 bit real number format. For this program, 
the user must define the record lengths and blocksize to the 
conversion program which then translate the tape as it is 
being processed. Since only one tape drive exists for the 
current REEDA configuration, it is not possible to convert 
the entire tape and rewrite it to another tape for subsequent 
processing, thus the UNIVAC 1108 and IBM 370/360 conversion 
programs prove more efficient in most instances. 

4.2.2 1965 KSC Rawinsonde Data Conversion Program 

The conversion of the 1965 KSC rawinsonde data tapes 
(18 tapes, four recordings a day for twelve months) for REEDA 
usability was performed. The BCD to ASCII conversion program 
for the UNIVAC 1108 was utilized to convert from 7-track to 
the 9-track REEDA format. In initial attempts to process the 
data, once it was converted to REEDA System format, it was 
noted (see Table 4-1) that a non-standard method of recording 
negative numbers was used when recording the original data. 
That is, a negative number was represented by over punching an 
(11) in the right most digit of the variable field. Thus, for 
the numeric values of 0 - 9 together with an (11) punch would 
give the visual representation as follows; 
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Table 4-1. Representative Rawinsonde Data 


TEST HER 0000 
R Ay I MS 0 HOE RUH 
CAPE KENNEDY AFS, FLA 
1115Z 02 MAR 1965 


ASCENT 

N B R 0 2 

66 

sVi TEMP 

V 







ALT FT 

y D I R 

WKT 

'^DEy 

PT PRES 

r* 

O 

RH AB 

H LI M 

DENI RVSWS 

0000 16 

16 0 

03 

194 

178 

1 0 09 1 

9 0 

1504 

1 1925 

355 

6 6 6 

0 0 1 0 0 0 

172 

03 5 

199 

1 82 

0 9 7 5 0 

89 

1539 

1 1497 

34 8 

667 

002000 

18 0 

04 0 

134 

154 

0 9 4 1 0 

82 

13 0 1 

11163 

32 6 

665 

003000 

193 

036 

173 

143 

0 9 082 

32 

12 10 

10 318 

314 

664 

004000 

198 

03 5 

157 

1 38 

0 3 764 

8 7 

1177 

10496 

30 5 

662 

C05000 

2 0 0 

03 5 

140 

1 18 

0 3 455 

86 

1 0 4 0 

10 19 4 

29 0 

66 0 

006000 

20 3 

03 5 

1 1 9 

0 99 

0 3.15 4 

8 6 

0 9 2 3 

09 9 07 

277 

-^65 7- 

007000 

20 3 

036 

093 

073 

0 7 86 3 

84 

0 7 3 1 

0 9 6 3 2 

26 2 

655 

003000 

214 

03 4 

074 

054 

07530 

87 

0 6 9 3 

09367 

25 2 

652 

0 0 90 0 0 

218 

036 

064 

OlH 

07305 

58 

04 3 8 

09076 

22 9 

65 1 

010000 

222 

03 3 

055 

0 4R 

0 7 033 

47 

03 3 0 

08779 

216 

65 0 

0 1 I 0 0 0 

224 

04 0 

03 9 

03P 

0 6 7 8 0 

57 

03 6 1 

08 5 0'3 

212 

64 8 

0 1 20 0 0 

22 3 

04 1 

026 

0 9 J 

0 6 53 1 

42 

02 4 9 

08 2 33 

19 9 

64 6 

013000 

232 

04 1 

005 

1 IR 

0 6 283 

3 3 

019 4 

07 991 

190 

644 

014000 

233 

04 0 

0 2 K 

13P 

0 6 053 

4 1 

0 1 7 0 

07 7 73 

184 

64 1 

015000 

244 

044 

04 P 

1 4P 

05825 

45 

0157 

07551 

178 

63 3 

016000 

25 0 

04 7 

07K 

1 IP 

0 5 603 

7 1 

02 0 4 

07 327 

17 6 

63 5 

0 1 70 0.0 

^ tr tr 

<; o j 

05 1 

09P 

1 IN 

05 389 

87 

0 2 0 3 

07 1 14 

172 

632 

0 1 8000 

253 

056 

1 2M 

1 3 ! 

05 179 

95 

0186 

0 6 9 0 9 

166 

629 

019000 

26 1 

05 3 

140 

200 

0 4 976 

62 

0105 

0 6 6 9 8 

156 

62 6 

020000 

26 1 

057 

15P 

22J 

04780 

53 

00 3 7 

0 6 4 6 4 

149 

625 



implies 


81! 

81J 

81K 

81L 

81M 

81M 

810 

81P 

81Q 

81R 


-810 

-811 

-812 

-813 

-814 

-815 

-816 

-817 

-818 

-819 


Thus a program was developed to process the data tapes 
to restore the number back to usable numeric notation. These 
tapes were then used as input to the REEDA System to build a 
"single tape" data base containing all pertinent information 
from the existing 18 tapes. The "single tape" data base allows 

the user easier/faster access to any/all data which he desires 

to process, thus eliminating the need to keep a library of 18 
tapes and the processing of data which is not desired (See 
Figure 4-4). 

The "single tape" data base was created by processing 

each of the 18 tapes and eliminating all data above 20,000 

feet in altitude for the standard and mandatory levels, thus 
eliminating a large portion of the data. This data base was 
updated after each tape was processed with an EOF (end-of- 
file) mark inserted at the end of each month. Thus a user 
can easily access any month from the "single tape" data base 
by skipping the appropriate number of files. It must be 
pointed out that the initial idea of a "single tape" data 
base actually turned out to be two tapes containing all 
selected information from the original 18 tapes. The first 
tape contains JAN - JUN 1965, while the second tape contains 
JUL - DEC 1965. 


It should also be noted that each of the 18 tapes 
being processed require about 2 hours to process on the REEDA 
System. Thus the initial creation of the "single tape" data 
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Figure 4-4. 1965 Rawinsonde Data Base Generation 

and Processing 
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base was quite time consuming, yet since it occurred only once, 
while the end product (i.e., "single tape" data base) is being 
utilized quite frequently. The overall effect of the "single 
tape" data base for the REEDA System is to allow the user to 
feasibly process all or as much of the 1965 KSC Rawinsonde 
data as efficiently and as fast as possible and to eliminate 
the handling of unneeded and unusable data. 

Various programs are now being developed to extensively 
process the 1965 data, such as M0D3B, METPL, and STAN5 
which are all documented in Chapter 5. 

4.2.3 1974 Vandenberg Rawinsonde Data Conversion Program 

The 1974 Vandenberg AFB Rawinsonde data tape contained 
two soundings per day (OOOOZ and 1200Z) for the entire year. 

The initial task was to convert the data into a usable format 
for the REEDA System. The original tape was generated on 
an IBM 360/44 and had variable length/variable block size 
records with half word alignment. A preprocessor was written 
in FORTRAN to restructure the data into fixed length records 
to be used as input into the IBM 370 ECBDIC ASCII conversion 
program. It was discovered that two types of data records 
existed on the tape, 1) PIBAL and 2) Rawinsonde. However, 
neither data record contained all the information that was 
required to process the data using the REEDA diffusion model 
program MOD3A. The PIBAL record contained pressure, altitude, 
wind speed, wind direction but not temperature. The Rawinsonde 
records contained pressure, altitude, temperature, dew point, 
but not wind speed or wind direction. Subsequently, code was 
generated to merge the two records by means of various inter- 
polations and calculations. The program computed the best 
possible values at the nearest altitude, pressure, and temper- 
ature. Figure 4-5 gives a brief flow of operations for 
processing the 1974 Vandenberg AFB data. 
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Figure 4-5. 1974 Vandenberg AFB Rawinsonde Data 

Converting and Processing 

Once the data was converted to a usable format for 
the REEDA System, the program MOD3B was used to process the 
data. It should be noted that the two soundings per day 
for the entire year of 1974 were contained on the initial 
Vandenberg AFB tape. Some 48 cases roughly a week apart at 
1200Z hours were processed. The program M0D3B is identical 
to the program M0D3A except it operates on the Plasmascope, 
which is interfaced into the REEDA System. It allows faster 
processing due to the use of "Touch Panel" program options. 

The output of M0D3B was 48 center line concentration plots and 
48 isopleth plots (see Figure 4-6 arid 4-7 respectively). This 
same data will also be processed on the REEDA System utilizing 
the new version of the program M0D3A. 
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Figure 4-6. 1974 Vandenberg AFB Centerline 

Concentration and Dosage Plot 
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Figure 4-7. Vandenberg AFB Isopleth Contour Plot 
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4.2.4 


1964 - 1970 Jimsphere Data Conversion Program 


A conversion program was written in FORTRAN to 
convert three meteorological data tapes, (1964 - 1966 KSC, 
1967 - 1970 KSC, 1965 - 1970 Point Mugu) containing 
Jimsphere wind data, to the REEDA System compatability . The 
tapes were initially created on an IBM 7094 with 36 bit 
word and data written in both fixed point and floating point 
binary. Each record contained 298 words with 20 such records 
per file. Additionally, each tape contained from 266 to 294 
files. The decision was made to only extract and convert 

the needed data to eliminate the cumbersome task of 
processing over and around data not needed for calculations. 
Only the time, date, altitude, wind direction, and scalar 
wind speed was deciphered from the original data. It should 
be noted that the wind speed and wind direction were recorded 
at equal intervals in altitude from 25 meters to 20,000 
meters. Thus, some 800 data points for both wind speed 
and wind direction were recorded for every Jimsphere profile. 

The conversion program was written for the UNIVAC 
1108 utilizing both ENTRAN and ENCODE features to convert 
the tapes into a format usable by the previously built 
EBCDIC and ASCII program. This encompassed converting 
from 36-bit to 16-bit HP word size, restructuring data into 
80 character fixed length records, eliminating unwanted data, 
and then converting to ASCII format as shown in Figure 4-8. 

As can be seen, a program to process the Jimsphere 
wind data on the REEDA System was created called JIMPL 
which will be discussed in Chapter 5. 
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Figure 4-8. Jimsphere Data Conversion and 
Processing 
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4.3 


CONCLUSIONS AND RECOMMENDATIONS 


These conclusions and recommendations are based on 
the conversion programs documented in Sections 4.1 and 4.2 
respectively. In reviewing the generic conversion programs 
that were developed, it seems that they have proven quite 
satisfactory in providing a mean for converting non-standard 
REEDA formatted data into a usable form. Data generated on 
almost any other computer configuration, either 7-track or 
9-track, either BCD or EBCDIC, either fixed or variable length 
records, can be made compatible to the REEDA System via one or 
a combination of two or more of the conversion programs that 
have been developed. However , it is still probable that data 
will be acquired that cannot be directly converted by using 
just the available conversion programs to date. Consequently, 
additional conversion programs undoubtedly will be developed 
as required. 

It is also recommended that in most instances, tape 
reformatting and tape converting be conducted on a large scale 
computer configuration where multiple tape drivers and faster 
operating speeds are available. 
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5. 


INTERACTIVE REEDA PROGRAMS 


In this section all of the applicable interactive 
REEDA programs are discussed. A brief description, along with 
current and future applications of each program is given. 

The following is a list of all the current REEDA programs 
which are discussed in Sections 5-1 thru 5-7. 

• M0D3A 

• M0D3B \ 

• METPL > REED Program* 

• STAN5 ; 

• MIXH 

• JWSPL 

• JTOPL 

• JIMPS 

• SKEW T (Version I & II) 

5 . 1 M0D3A 

The HP 9820 breadboard version of the REED Description 
Model 3, previously used to monitor launches (46-49) has been 
rewritten, liberally commented, and made research operational 
on the REEDA System as an interactive program to test human 
factors and provide a real-time research capability for surface 
air quality predictions. The program asks questions of the 
user and accepts answers in English words and phrases. Using 
an X-Y plotter, it draws concentration and dosage versus dis- 
tance plots as well as isopleth contour plots. The equations 
used for the cloud rise and diffusion are in an extremely sim- 
plified form and are being expanded to give a more accurate 
representation of the cloud mechanics and the diffusion process 
This version does not permit diffusion calculations aloft, does 
not allow for options like surface absorption, rain scavenging, 
or AlgOg deposition. 

♦These have been merged into the NASA/MSFC REED Diffusion 
Mqdel Program Version I. 
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The distinct advantages of having the diffusion model 
operational on the REEDA System are two-fold. First, because 
the system is dedicated, the program can be run in almost 
real-time, .thereby allowing last minute analysis and decisions 
to be made. Secondly, because of the interactive nature of the 
program, it is not necessary to have a trained computer person 
run it. Any scientific person knowledgable in diffusion theory 
can, with a brief orientation, successfully operate the program. 
Knowledge of diffusion theory is required because SIGAR and the 
top of the transport layer determination calculations have not 
yet been automated. 

5.2 M0D3B 

A version of M0D3A, called M0D3B, has been written 
for the REEDA System to use the Plasmascope installed on 
the system. Because of the Touch Panel feature on the scope, 
it is easier for the user to answer the yes/no type questions 
asked him by the program. He need only touch the YES or NO 
area on the screen instead of typing in the answer. Further 
man-machine interface improvements using the Plasmascope 
are planned for M0D3B to make the program, both input and 
output, as simple and informative as possible. 

5.3 JIMPL 

A program, written in FORTRAN, to process the Jimsphere 
wind data was created on the REEDA System. This program pro- 
duces both scalar wind speed and wind direction plots. An 
example of each is given in Figure 5-1 and Figure 5-2 respec- 
tively. This program requires as input the following data on 
altitudes ranging from 25 to 20,000 meters. 

• Time 

• Date 

• Altitude 

• Wind Direction 

• Scalar Wind Speed 
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HLTITUDE (KM) 


CAPE KENNEDY JIMSPHERE HIND PROFILE DATA 
APR 16-17. 1967 

20 
18 
16 
U 
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2 



NASA - M8FC , 
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Figure 5-1. Example Jimsphere Scalar Wind Speed 
Plot 
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Figure 5-2. Example Jimsphere Wind Direction Plot 
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This program was used to initially process the KSC 
and Point Mugu Jimsphere wind data to determine temporal vari- 
ation in the atmospheric kinematics to support climatic dif- 
fusion assessments. Over 150 plots were generated. Several 
modifications were found desirable such as the inclusion of 
a filter to eliminate bad data or noise, and provide the 
ability for the user to select only those specific profiles 
of interest. The ultimate desire was to be able to see a 
plotted profile without having to actually plot it. This 
would allow the, user to process only data of interest and 
allows the creation of final Jimsphere profile plots without 
having to process the data several times. 

Consequently, programs to process Jimsphere wind 
speed/direction (JWSPL, JWDPL and JIMPS) were developed for 
the REEDA Plasmascope which allows for "touch panel" control. 
Research or production options are available to allow the 
user to process all, or portions, of the data with graphic plots 
on the Plasmascope or hard copy plots. Program JIMPS 
allows the user to visually display a complete Jimsphere 
wind speed direction plot on the Plasmascope, thus 
allowing the user to quickly scan and edit the data before 
making a hard copy plot. This feature ensures the ability to 
only generate useful hard copy plots. 

The programs JWSPL and JWDPL process the Jimsphere 
Wind Speed/Direction data respectively. Each allows the user 
to easily process Jimsphere data quickly through "touch 
panel" questions and answers, thus eliminating the possibility 
of erroneous keyboard input. An example scenario from the 
program JWSPL is given in Figure 5-3. Hopefully, it can be 
seen from the scenario that by using the Plasmascope "touch 
panel" control the possibility of making input errors (keyboard) 
are reduced. A noncomputer oriented user can easily be taught 
to use such a program within minutes. 


5-5 



TOUCH DESIRED ANSWER! ! ; ^ , 

**NASA/MSFC Jimsphere Wind Profile Program** 


Data Being Processed? 

Date of Data? 

Profile Desired? 

Date of Sounding is: 
New Date Desired? ' 

Time of Sounding is; 

Plot Desired? 


Cape 

Kennedy 

Point Mugu 

1964 

- 1966 

1 

1967 - 1970 

Wind 

Speed 

Wind 

Direction 


December 29, 1967 



♦*Turn on plotter — Insert paper 


♦♦Touch panel when ready 



♦♦Plotting has been initialized 


Time of Sounding is: 1500Z 



Figure 5-3. Example of Operating JWSPL Plasmascope 
Program 
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The overall results of the Plasmascope Jimsphere 
programs have been quite successful and time saving. Over 
700 finalized Wind Speed and Wind Direction profiles have 
been generated from the KSC and Point Mugu data. 

5.4 METPL 

METPL is currently a stand alone research program 
generated to allow visual display of Wind Speed, Wind Direction, 
Dry Temperature, Potential Temperature, and Cloud Stabilization 
Height as one profile upon the Plasmascope. This program should 
be interfaced to M0D3B. As an example of the meteorological 
profile as it appears on the Plasmascope is shown in Figure 5-4. 
Various questions will appear at the bottom of the Plasmascope 
to direct the user as to the moving up or down of the top of 
the surface mixing layer to the desired height as well as giving 
the option for a hard copy plot of the generated profile. The 
meteorological profile is normally obtained from a Rawinsonde 
of the atmosphere. To obtain the entropy profile required for 
these soundings, the temperature and pressure are translated 
into the potential temperature in accordance with the following 
equation: 

0 = T ^IOOO 

where the concept of a potential temperature (9) is introduced 
to reference the temperature to a specific pressure (1000 mb). 

5 . 5 STAN5 

Program STAN5 is a research stand alone program 
written in FORTRAN and operates on the REEDA System. This 
program should be interfaced to the M0D3B program. STAN5 
calculates the standard deviation of the horizontal wind 
azimuth angle, SIGAR. Input data are the temperatures, pres- 
sures, and altitudes of the first three data levels of KSC Ra- 
winsonde soundings. The levels are the first and second standard 
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Figure 5-4. Example of METPL Plasmascope Program 
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altitude levels (16 and 1,000 feet) and the first mandatory 
pressure level (1,000 mb). The roughness length along the air 
trajectory with the surface transport layer is also an input 
variable. The background for the calculation is described in 
Section 2. 

The output of STAN5 includes the time and date of 
the Rawinsonde sounding, the input data, calculated non- 
dimensional parameters, the gradient of potential temperature, 
and SI GAR. 

5.6 MIXH PROGRAM 

Program MIXH is a stand alone research program which 
operates on the REEDA system. MIXH selects a surface transport 
layer height based on criteria described in Chapter 2. The 
input data is a Rawinsonde sounding. MIXH calculates virtual 
temperature at each level and tests the data according to 
the prescribed criteria for virtual temperature gradient 
corresponding to the base of a stable layer and the top of 
a stable layer. The layers must have a thickness of at least 
100 meters. The base of the stable layer nearest to the 
ground is offered as the height of the surface transport 
layer. If a stable layer is ground based, then the top of 
the stable layer is selected as the transport layer height. 

If no stable layers are found between the surface and 3000 
meters, then the transport layer height is set equal to 
3000 meters. The output of MIXH is the mixing height of the 
surface transport layer. If the theory is upheld by extensive 
test, it should be interfaced to the M0D3B program. 
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5.7 


SKEW T 


The existing SKEW T REEDA System program, originally 
written by Dr. J. B. Stephens of MSEC, was modified to enhance 
its capabilities in processing sounding data. It can currently 
accept sounding data from both magnetic tape or disc and in a 
variety of user specified formats. The SKEW T program generates 
logarithmic plots for both dew point and temperature as a function 
of altitude as shown in Figure 5-5. 

The SKEW T program was used to process some 23 
cases of Battelle Thiokol data for 1974. One additional 
modification was made to the SKEW T program to allow for 
processing the Battelle data, which was the calculation of 
dew point from a given relative humidity and temperature. 


5.8 CONCLUSIONS AND RECOMMENDATIONS 

These conclusions and recommendations are drawn from 
the discussion of the interactive REEDA software described 
in Section 5-1 thru 5-7. It should be evident that a variety 
of sophisticated interactive REEDA software has been generated 
and utilized during thiS' contractual period. A vast amount 
of data from various sources have been processed, analyzed, 
plotted, etc., by the different REEDA programs. The REEDA 
software has proven effective, efficient, and invaluable in 
providing both f ast/accurate results in both statistical and 
graphical form. The current REEDA software, especially the 
Plasmascope programs provide a means for even a non-computer 
oriented user to operate and get results with very little 
effort. The Plasmascope "Touch Panel” capability provides 
not only for faster user response (i.e., touch-vs-keyboard) 
but proves superior to the CRT program due to the fact it 
virtually eliminates or safeguards the user from entering an 
erroneous value/answer. In addition, due to the 512 by 512 
raster dot resolution provided by the Plasmascope virtually 
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Figure 5- 


. Example of SKEW T Plot 
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unlimited visual graphic display can be generated. 

It is recommended that all existing stand alone REEDA 
software be extensively tested and validated to its fullest 
extent, with state-of-the-art Plasmascope technology being 
incorporated whenever and wherever feasible. Additional REEDA 
software should also be developed, utilizing the REEDA Plasma- 
scope technology, to provide even more capabilities in pro- 
cessing both present and future sources of data. 
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6. NUMERICAL CLOUD RISE MODEL 


Under contract with the Army Missile Command High 
Energy Laser Programs Office, SAI has recently developed a 
digital computer program (PUFF) representing a first-order 
mathematical model for describing the behavior of clouds 
produced by short -duration high temperature exhausts. In 
order to more clearly identify and understand the important 
features associated with the problem of cloud behavior, the 
cloud history was divided into three phases as depicted in 
Figure 6-1 and as tabulated in Table 6-1. As indicated in 
the figure and table, the cloud’s history from the time of 
its initial formation until it reaches equilibrium altitude 
is contained within Phases I and II. PUFF was primarily 
designed to handle the problem of cloud behavior during 
these two phases. 

The basic model upon which PUFF is based is the result 
of a study of relevant literature, both theoretical and experi- 
mental. In essence, the cloud is treated as an open thermo- 
dynamic system within which all properties are assumed to be 
uniform. The cloud shape is represented by a sphere and 
cylinder combination as shown in Figure 6-2. The cloud 
behavior is predicted by the simultaneous numerical solution 
of the 

• Conservation equations for 

1) Mass 

2) Momentum (3 components) 

3) Energy 

• Equation of state 

• • Volume and center of mass relations for cylinder 

and sphere combinations. 
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Figure 6-1. General Representation of the PUFF Program 
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Table 6-1. Phases of the PUFF Program 


Phase 

I 


II 

III 


Cloud 

Behavior 


Dooiinant Other Effects 

Effect Present 


(Ihernx>- 

dynamic 

Phase) 


Vortex ring 
with tail 
formed near 
vehicle 


"Tadpole" shaped, 
cloTiid rises throuj^ 
atmosphere 


Exhaust 

momentum 

flux 


Buoyancy 


Buoyancy, Drag, 
Diffusion 


Drag, Diffusion 


(Kinematic Cloud reaches Diffusion Drag 

Phase ) equilibrium 

altitude and 
spreads out 




- length of tail 

- radius of sphere 

r - radius of exhaust 
e 

- distance from exhaust to end of tail 

X - distance from exhaust to center of mass 
cm 


S’igure 6-2. Cloud Shape 
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The resulting solution yields 


• Position (x,y,z) 

• Velocity > ^^ 3 ) 

• Temperature 

• Density 

• Shape* 


of the cloud as a 
function of time 


6.1 MODIFICATIONS TO PUFF 

Some modifications to PUFF are necessary to allow 
it to be applied to the situation shown in Figure 6-3. Some 
of the changes are general, relating to both the duct cloud 
and the ground cloud, while other changes deal with the 
ground cloud only. 


6.1.1 General Changes 

General changes to the program include (1) the 
introduction of atmospheric density and temperature profiles, 

(2) the calculation of energy released by chemical reaction, 

(3) the calculation of thermal radiation emitted by the exhaust 
products and (4) the calculation of the behavior of liquid 
droplets and solid particulates suspended in the exhaust gases. 

The use of atmospheric density and temperature pro- 
files would be based on atmospheric data obtained from 
soundings. Soundings are taken at regular time intervals 
before each firing and twice a day normally. 

The calculations of the energy released by chemical 
reaction would involve maintaining an inventory of the chemical 
species present in the cloud and computing the rate and total 
amount of each significant reaction associated with the 
production or consumption of each species. The techniques 
used in the afterburning analysis and for maintaining an 
inventory of chemical species have been discussed in Section 
3.2. 


*In terms of length of cylindrical tail and radius of spherical 
body . 
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The spectral characteristics of the thermal radiation 
emitted by the exhaust products (gaseous, liquid droplets, and 
solid particulates) are quite complex and calculation of such 
characteristics is not a simple task. The total radiation 
emitted by the various constituents, however, can be calcu- 
lated by standard engineering techniques and should prove 
adequate foi' the type of model under consideration. 

The behavior of liquid droplets and/or solid particu- 
lates within the cloud depends upon the size of the droplets/ 
particles and the velocity of the flow. Methods for predicting 
such two-phase flow phenomena have been presented in 
Subsections 3.1 and 3.3. 

6.1.2 Ground Cloud Changes 

In addition to the four general changes noted in the 
preceding subsection, there are certain modifications which 
relate specifically to the ground cloud alone. PUFF was not 
originally designed for the case where the rocket exhaust 
impinges on a solid surface. The program can be easily modi- 
fied such that in the presence of a solid surface, a surface 
force is introduced into the momentum equations in such a 
way that the ground cloud center-of-mass cannot, pass through 
the surface. 

Although the ground cloud center-of-mass does not 
penetrate the surface, allowance must be made for mass, 
momentum, energy, and species to escape from the ground cloud 
through the flame trench entrance and ultimately into the 
duct cloud. All such losses to the ground cloud would be 
added to the duct cloud to satisfy basic conservation prin- 
ciples. Calculations of the magnitude of the losses would 
depend upon the height of the rocket engines above the flame 
trench entrance. As the launch vehicle ascends, the amount 
of exhaust gases passing through flame trench entrance 
decreases. This decrease results from the vertical rocket 
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exhaust plume cross section (at ground level) increasing with 
time while the velocity within the plume (as ground level) 
is decreasing. 

In the original version of PUFF, the origin of the 
coordinate system was the center of the jet exit plane. For 
the case of the ground cloud, this origin would move upward 
as the launch vehicle ascends. Because it is desirable to 
have an origin which is stationary with respect to the ground 
level, PUFF must be modified such that the origin remains 
fixed at a point corresponding to the center of the rocket 
exhaust exit plane prior to liftoff. The rocket exhaust exit 
plane after liftoff will be programmed to move upward in 
accordance with the known trajectory of the launch vehicle. 

Another modification to the program would involve the 
manner in which the buoyant force is calculated for the ground 
cloud. Currently in PUFF the buoyant force depends on the dif- 
ference between the mean cloud density and the atmospheric 
density at ground level. The atmospheric density surrounding 
the tail of the ground cloud varies with altitude and thus 
the buoyant force should involve an integral of the density 
difference over the altitude interval from ground level to 
the end (top) of the ground cloud tail. 

6.2 CURRENT STATUS OF PUFF PROGRAM 

The PUFF Program was converted from the IBM 370 
to execute on the REEDA System. Various software incompati- 
bilities had to be resolved, such as: 

• Label common not supported 

• Multiple entry points not supported 

• Initialization of common variables in data 
statements not supported 

• Block data not supported 

• Namelist read not supported 
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These were the initial problems which had to be resolved for 
a successful compilation. A benchmark run for PUFF on the 
REEDA System has been established. The necessary logic has 
been prepared to modify PUFF to account for : 

• a variable atmosphere 

• a moving exhaust nozzle 

• a solid ground level 

A mathematical model for calculating the jet stagnation length 

has been established. The necessary data for calculating 
the radiative emittance of the exhaust products have been 
collected. Once this was accomplished a benchmark comparison 
was made; however, some discrepancies were noted. When the 
REEDA version of PUFF was compared to an IBM 370 operational 
version identical results were obtained from the initial time 
until time was equal to 0.10 seconds using 0.01 sec time 
increments. At this point in the execution of the program, 
the time increment was increased to 0.10 second. Using the 
new time increment, significant differences begin to appear in 
the calculated results. Various modifications were made to 
try to eliminate the difference. All variables and calculations 
were changed to double precision. Various complex arithmetic 
computations were re-structured into less compound statements 
to eliminate possible loss of accuracy by truncation, etc. 

The above changes have not affected the final results. There 
still remained differences in the results when the time 
increment was increased to 0.10 second. Thus it was decided 
not to increase the time increment, but to leave it constant 
at .01 second for the entire duration of the program to 
determine if better accuracy is gained at larger times into 
the run; however, the results did not change. Consequently, 
analysis of the REEDA version of the PUFF Program will continue 
with appropriate modifications being made. 
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It should be noted, however, that due to the differ- 
ence in hardware (i.e., IBM 370 vs HP 21MX REEDA), 32 bit vs 
16 bit single precision words), 64 bit double precision vs 48 
bit double precision words), (16 significant digits vs 11 
significant digits), complete agreement between the results 
of the two machines may not be obtainable given the algorithms 
that exist currently in the PUFF Program. 

6.3 CONCLUSIONS 

A new numerical cloud rise program developed for 
another purpose has been investigated to see if it is suitable 
for use on the exhaust cloud from the Space Shuttle propulsion 
system. Development has been initiated to modify the original 
code and convert it for use on the REEDA system. The use of 
this code would allow the simultaneous determination of the 
cloud shape and size and the radiation loss from the exhaust 
effluents. No other known analyses can handle the situation 
as aptly as the PUFF code. 
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7. OVERALL CONCLUSIONS AND RECOMMENDATIONS 


The study performed under NASA Contract NAS8-31806 
has yielded large dividends In the technology learned, the 
basic algorithms developed, the meteorological knowledge 
about KSC brought to a useful form, and the large amount of 
software developed. New techniques utilizing the touch panel 
on the Plasmascope have yielded programs that are convenient 
and rapid to use. The effort has basically completed the nec- 
essary homework for a full scale climatological diffusion as- 
sessment ; what is now required is to bring together the various 
models and start the development of an operational diffusion 
model useful not only for a climatological assessment but for 
monitoring operational launches. The technique for the cal- 
culation of the SRB exhaust effluents has been developed but so 
far losses due to plume impingement, radiation, the flame 
trench, and water injection have not been considered. A pre- 
lininary climatological diffusion assessment was performed to 
validate the techniques developed; the results have only limited 
validity and no conclusions can be drawn from the results of 
the study. The study assumed the Space Shuttle was a Titan 
type vehicle with only solid propellant boosters; the liquid 
propellant SSME and their interactions with the solid motor 
effluents were not considered. 

7 . 1 RECOMMENDED STUDY 

Ground-based stable layers and inversions are common 
over land areas near KSC during calm clear nights, especially 
in winter. The percent frequency of occurrence of ground 
based inversions for various thickness intervals by season at 
KSC (50) is given in Table 7-1. 



Table 7-1. Percent frequency of occurrence of ground-based 
inversions by season at KSC during 1965 - 1969 
at 0700 and 1900 EST. 


Thickness 

Dec 

Mar 

June 

•Sept 

of Ground Based 

Jan 

Apr 

July 

Oct 

Inversion (m) 

Feb 

May 

Aug 

Nov 



<100 

2.1 

1.2 

1.5 

2.1 

101 

- 250 

32.4 

25.3 

30.2 

23.5 

251 

- 500 

23.5 

22.8 

27.6 

26.0 

501 

- 750 

2.5 

4.1 

1.3 

0.6 

751 

- 1000 

1.6 

0.6 

0 

0.6 

1000 

- 1500 

3.5 

. 2 

0 

0.2 


>1500 

0.7 

.2 

0 

0.2 
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The statistics in Table 7-1 are based on Rawinsonde 
data. Shallow ground based Inversions (thickness less than 
250 m) reported at KSC are based on a surface temperature (at 
16 ft) and a temperature at the first mandatory pressure level 
(1,000 mb). Since the temperature at 16 ft is strongly in- 
fluenced by local micrometeorological conditions the statistics 
of shallow inversions are not representative of other locations 
beyond a short distance from the measurement location. How- 
ever if inversions are reported based on temperature obser- 
vations at three or more altitudes (including the observation 
at 16 ft) there is more support for the argument that stable 
conditions exist near the ground over a wider area in the 
vicinity of the measurement site. Since a ground based stable 
layer at a particular location will effectively insulate 
that location from the stabilized SRB cloud, it is important 
to establish the applicability of the available KSC inversion 
statistics to the climatological impact analysis. The 
physical processes responsible for the formation of 
ground-based inversions in the areas surrounding KSC 
are influenced by the relative distribution of rural and 
urban topography and water bodies. Urban areas and water 
bodies during winters at KSC represent nocturnal heat sources 
which could contribute to the maintenance of a nocturnal mixed 
layer. Although a nocturnal mixed layer has been identified 
over large cities (51, 52) its existance has not been iden- 
tified or correlated with nocturnal heat sources in the 
vicinity of KSC. 

It is a reasonable hypothesis that the inversion 
statistics obtained from KSC Rawinsonde data are not neces- 
sarily representative of conditions at all locations of in- 
terest in the vicinity of KSC. It is suggested than an 
experimental study be implemented to establish the relative 
strength and frequency of occurrence of ground based stable 
layers and inversions over various locations of interest 
near KSC. Adequate results would be obtained by sampling 
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temperatures aloft (to 1 km) daily, 1 hour before sunrise, 
during January and February over population centers (Titus- 
ville, Cocoa), working areas, and viewing areas within KSC 
boundaries. The purpose of the study will be the establish- 
ment of the degree of conservatism of air quality impact 
calculations based on the available large sample of Rawin- 
sonde data at KSC. 
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APPENDIX A ■ 

SOFTWARE SOURCE LISTINGS 

This section contains the complete source listings 
of most of the software programs discussed in this report. 
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Conversion Programs (Generic) 


• IBM 370/360 

• UNI VAC 1108 

• HP 2100 


BCD/ EBCDIC -> ASCII 
BCD/EBCDIC ASCII 
EBCDIC ^ ASCII 
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IBM 370/360 BCD/EBCDIC -»• ASCII Conversion 
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LOC OBJECT CODE AOOBl ADOBE STBT SOUBCK STATENCMT 

1 I BBINT N06EN 

2 HUDTADE BEAOV 

12 BDJFCB fTAFEI 








18 

OFEN 

(CABDIN,,TAFE»10UTP0ni 

a0002E 






26 BEAOCABO 

OS 

OH 







27 

SET 

CABOIN 

00003B 

1821 





31 

LB 

2»1 

00003A 

0503 

204C 

C358 

0004C 

003SB 

32 

:lc 

76l6,2lt-C* li* 

QOOO^O 

4780 

C05A 


OOOSA 


33 

BE 

CLOSE 

J00J44 

0C4F 

2000 

C198 

00000 

00198 . 

36 

TB 

0I80,2)«BC0T0ASC 







35 

PUT 

TAPE»I2I 

000056 

47F0 

C02E 


0002E 


60 

B 

BEAOCABO 

00005A 






61 CLOSE 

OS 

OH 







42 

CLOSE 

(TAPEtLEAVEI 

000066 

4820 

C128 


00128 


68 

LH 

2.JFCBABEA66B 

0U006A 

4120 

2001 


00001 


69 

LA 

2.1lt2l 

U0006E 

4020 

C128 


00128 


SO 

STH 

2.JFC8ABEA468 







51 

OPEN 

1 TAPE. lOUTPlIT tLEAVEI »•T7FE■4 

0UU07E 

47F0 

C02E 


0002 E 


57 

B 

BEAOCABO 

000082 






SB EOF 

OS 

OH 







59 

CLOSE 

ICABDIN..TAPEI 







67 

BET 
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LOC OBJECT CODE AOOR1AODR2 ST4T ' SOl/ttCE ’STATEMENT 


3000EA 

'-S 

■ 75 

JFCBAREA 

■« - 

DS 2 

99F 

00U194 

B70000E4 

76 


-‘DC;’: 

X* 

87'f AL3< JFCBAREAI ; 

U0019B 

0001020309050607 

77 

-BCOTDASC 

DC". = ■ 

X* 

OOOlO203a90506O70a09OAaB0C00a£0F' 

Q001A8 

1011121319151617 

78 


OC 

X* 

10 1 1 1213 1915161713 191A1B1C1;}1E IF* 

OOUIBB 

2021222329252627 -V 

79 


DC -r 

X* 

2l9212223Z9^526^72a292A282C202E2F*( , 

OUOICB 

3031323339353637 

80 

i 

OC . ;■ 

X' 

30 3132333935363733^?3A,3Bi3p;3P3E3Fi*^ ^ 

OOOIDU 

y 

9192939995969798 - 

81 


oc:, . 

X* 

9?9293999Si(b9yi&49'9A* ' 1 ^ 

0001D9 

92 


DC... ; 

X* 

JOOIEJ 

2E295B3C9F20 \' 

83 


3c: 

X* 

2E295a3C9F2B» 

Q001E9 

5152535955565758 

69 


,?c: 

X* 

5152535955di5758595A* ' ‘ . 

300 IF 3 

292A5D3B5F2n2F * ... 

.85 



X* 

292A5Q3B5F2D2F* . ; 

OOOIFA 

62o3696566676a^>f , ' 

' 86 


oc^- 

X* 

62636965666763696A' , 

000;£U3 

2C206P5C6F ' ' '' ' ' 

87 


oc; * 

X* 

2C2B6D5C6F''' 

OOOiiOlS 

7071727379757677 

88 


oc •' 

X* 

7071/2737975767773T9U* ' ■ 

330213 

30273A3E7F80 ■ 

■89 


QC ’ ' 

X* 

3D273A3E7F80* • ■• • • ' > ' 

0U02t9'-Wftr6’3%V6'%S6SfWrf ' ■ ’ ’ ' 

■do 


oc' ■■ 

X' 

616263696566676869* 

000222 

aA3B8C3D8E3F90 

91 


oc - 

X* 

8AB08CQ08EBF90* ! ' 

300229 

6A6H6C6D6fcSF7071 

92 


o: * 

X* 

6A636C6D6E6F707172* 

300232 

9 A9B9C9D9E9FA0 ’’ - ^ ' • - 

•'■43 


3C- - 

X* 

9A9B9C909E9FA0* 

300239 

7C 73797576777879 

99 


DC’ ; 

X* 

7E737'+75767778797A* 

000292 

A AABACADAEAF 

95 


oc 

X* 

AAABACAOAEAF* 

00029a 

B0BlB2B369B586a7 

96 


oc 

X* 

B0aiB28389B58&B7B8B9BAB3aCB0BEBF* 

00025B 

3F 919293999 59697 

97 


oc 

X' 

3F9 19293999596979899* 

000262 

CAr.acccocecF 

98 


oc 

X* 

CACBCCCOCECF • 

000268 

2194989C909E9F50 

99 


oc 

X* 

219A989C9D9E9F505152* 

000272 

DAOBDCDODEOFEOEl 

100 


DC 

X* 

DAOBOCDODEDFFOEl* 

0002/A 

5359 J5565758595A 

101 


DC 

X* 

535955565758595A* 

000282 

FAE3EC£:0£EEr- 

102 


DC 

X* 

EAEBECEOEFEF* 

000288 

3031 323339353637 

103 


DC 

X' 

30313233393536373839* 

000292 

FAF8FCFDFEFF 

109 


oc 

X' 

FAFBFCFOFEFF* 



106 

CARDIN 

0C8 

OSORG=iPS,MACRF = SLf00NAHE*CARDS,E30AD>E0F 
RECFH=F8,LRECL-80 



160 

TAPE 

DC 8 

OSnRG=PS,MACRF«PM,DONAME»TAPE,EXl ST-LIST 
RECFN=FB,LRECL-80 

oooooo 


219 


END 

HWPTAPE 

000358 

90909089 

215 



*c 

• U* 


A-5 


S' 
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lister • 


01 

ww^wul-*** 

UuJ^ii2 

— —— — — 4 # w w w - 

-iluu«*w 7 - 

4iaMt#10 

— tfU j*j 1 -I — 

tiwOw 1 2 
— : Ut#‘ii»l^ 

U*.i*w I H~ 

1 £i 

OwJ -16 - 


14 00 iiO UOOOO* 
0L-«^1 — G0-iri>-'O-'VuOw|'l 
1 w I 4 03 MU 6wyi«JS 


; IS 00 
i-l4-00- 
i uH Cu 
#-- 14 ' CO 
^ wO 01 
»- otf — 0 1 

# wu 02 

* -'ilr 00 ■ 

I 00 01 
i 00 02 
' 0|7 Ou 


Om u vwUwlO 

■Oc —Ovy WO 1 

oO o 0 m& i 4 1 

«IO COOmSH-— - 
00 0 0-UISH 
iiO O uwtilSS— 

00 6 OuJlS^ 

Ow ■ OcfOwt-u 

U 1 2 OwOuqO-- 
wl 2 UwOwOO 

1 u OjOu I *• 


LA,U Ao*CARO > 

~SA.»i 2 

la»u ao»kopack 

H&Jl ^O** 

LA»Sl AtitSTATUS 

Awfl 


uuOwl? 27--uCr01'0W'W'0u0i 57 

MwOw2m 27 uO 02 uO U OuClSH 

- - ' ^ bO^- 

00^^21 ly IS 01 ill 0 OwjyOd 

— Uvuv22 1 »~w0~02 — 1~5— CvOwSr'l 

(#«#yu2^ 7^ l2 02 Oy £i dvOwJH 

— 0wtjw2^"~*’l V — l*f—Ol — 4 l" "‘ 0 WyOyOO — 
u%-a^2b Iw 00 lO lb 3 JmJwSH 

■ uywu24 — 7-i-'-l-2 -1 4- Ou‘ O'- 0*>0y2^* 

uoww27 4w oO C|2 Uy 0 
"“win/iw””! V — i-'A- O l*“w 1 — w~'wO‘*DO ■" - 

OwuwJl Iw uO 1^ IS w OuwWb^ 

wyOw.42 7^-12 -l^- oO 0 OvO^t*^ 

Oyuy^d *t'y Ob U3 uO o (#«*0 m32 

" OiiwM-l'i * 1 m -1 2- ul— ill" •W — yuCtMUM' - ' 

1m bu 1^ 15 0 wuCmSH 
““uy ;iu3 6 — ~-7 2*- %/»y— W— OwowO*!"" “ 

wuyM^/ *1^ uO 0^ wO 0 ww 0 i *32 

• tiMUvfSy — Iw “ll — tl l—v-i— ii- iluCjyCO 

UMiJy^l 1 m iiii 14 lb 0 yvJifSH 
■• OuumH 2 — Iw 1 4 1 7- i»ti 0 ummUm - 
Oi#My*13 73 »jj 14 O uuCyO^ 

— ■“•iv-vw o5 — vw-'0-'uu0w32- ■ ■“■• 
OiaO^Mb 0l wO 04 v#2 2 iiwUMOO 

uuyOH# • Iv-Oti Q2 %ti3 - 0 0w0y3^ — 

OM-Oy*17 1 m lb Cl ul i wwdvOil 

- OwUmSw 1m wC I a -4 5 -0 mOumS^ — 

ywy^bl 73 12 14 uO U 0i#3w30 

*"WUiiwS2 Hu*vO“C2 — U4- - O- vwCv 32 


J LaSTcU « 

LAtII A»rCA«D-H^ • 

LX AlidiUlNei • 

t-A 

LA A2t (OaOHoiOu2CutO’ 

LA-f U — A3 « 8 « — 

5 A A I lOi^Xl •-- 

SA A2»0,*XI , 

dS© A3 I blank- f 

-fcX A|- » ( 1 « CARD I ■ — 

LX A2t<l«LINEl « 

LA^Si A|yU»Xl • 

— tA Ain^'2 A S < -r A| • 

LSSL A2t28 • 

LA AI*ltPU2ASC»Al « 

DR A2>am • 

h- A i S a A+tC-i X I 

LA AlHilU2A5C»Al • 

— i^sat • — 

OR A3tA|4 • 

— L-A-»S 4 Ai »C»vX| «• — 

LA AlHtFD2ASCftA| • 


AH»AM 

-Al rWfXI 

At‘*fF02ASC» A1 

~AlStD 

A 1 H»M 

— Ab-f AH 

A6»y »«X2 

~A2«A|b 

AltCHXl 

-Ai4ifD2ASCtA-l— 

— Ar 2 'rA'i N 


-4 S- TT-Alf ^ 0 r — : 

YLS« QO BRite eor< 


SA 

-LA 

LA>S4 

-LA 

LSSL 


ODD ROMO* 


A- 7 



iiwwu <>4 Hw bO wO 0 

lu -i-H Ol til Cl iiuQuOti — 

uwww 6 o 1 m l 6 ib U ifMObS*! 

•■ Uij Ju6 7— ‘ 7 i 12 - 16 liO b uuQulu — 

< 1 ^ 0 ^ bb b 0 uUu 32 

— U«*iw 7 i — iir-t- 3 ^-at“ d' O' uwOoCU — 
iibWM 72 Iw iij 16 lb it Cw;juSH 

— Hu— v;7ufr ciu"i7 - uwaw32 — 
bcuu 7 H ui uj 26 u 2 ^ bM&wQu 
~uu'jw 7 b - lu 1 - 2 - Ol ul -O' uuOuOv-- 
0 w^*j 76 I ifj Q2 JS 0 

"xrau^7 f- — 7 ^ — 12~02- wtT"0 — — 
(imJIOu tb li Ql ul 0 uuOuOO 

uui^l’ui 1 w —o tj— 1 6 -iS — ir-'OvSu&'l — 

uum 1 u 2 73 12 16 uO 0 i#b 0 u 2 *l 

Cbultii iy— ud~fl2^ oO -O — 

bwOlwH'' 1 «r ij 01 ul 2 UmOuQU 

uuu'lu6 73 l2 16 ub 3 UuQulH 

~6'mm' 1 «7 — H'O'"v0~03 — — 


uuUilO 0^ 02 ol uO 0 OwUul2 

— CuOM'l b'^vi' C3-'u0 ‘O 

0uuU2 7H OH Ou wg 0 CuOM6 
~Ougl 13"' Hw 00 OH ui^ O - 0w3 1^6 1' 
OwJiM Qi 00 0& u2 0 OuOuUO 
~Ouoll& — yn iiH 00 uO 0 OuOISH- 
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0i.SI3d 

-tiwuia't- 

Ob«»l3S 

-dwifi ... 
U^QI37 

-wtirjji — 

uuulti 

iiu-J>42 - 

Uw.jl‘<3 

- buu I '♦* 17 - 
buJl‘«S 

-Dvijl'**— 

UCii*t7 

- uu j • S6- 


73 12 
•la.ua 
tj 12 
“1 « uvl 
73 12 

lu 11 
1 *• tlO 
73 12 

Utl 
1 1 

■ " •- Cl 

rw irv^ 

uu 

00 


14 00 
02 00 
01 01 
14 16 
14 UU 
■60— oO* 
31 yl 
14 IV 
I 4 Oil 
OH uO 
01 01 
4 V IV 
QS 00 
04 w2 


0 oyooao 
.0 0 ^ 0032 - 
6 CwOyOO 
O' OyQySH^ 
0 «ly0u20 
-M— ii «*}y 0 2— 
O 0«#0u00 

w Ows^y&H - 

U J^aOulO 
■O 0w0a32 
2 OyQuCO 
"O" wuuuiii V- 
0 0^3^32 
2 OwOuOO 


OmOI^I 04 0^ Cl uu 0 iiu0ul2 


,12/. 

ullylbO 

7H 

OH 

Ou 

Mo 

0 Oyi3M2l 








i;*'. 





/ 


1 3'J* 

OoUlSS 

lu 

16 

00 

tiu 

ooOu 1 3 — 

j j j • 

0wJI3& 

01 

ul 

00 

oC 

0 CoCoCH 

i 3 ; . 

• (ix J 1 

lu 

16 

Ou 

ou 

OygyCo 

1 3J« U 

tluU>S7 

7i 

1 1 

OG 

Ou 

'6 uOOuOO 

I3M, 

tiyu 1 6|j 

7H 

OH 

00 

oO 

0 OuOooO' 

13b. 







137. 
139 • 

UuulAl 

— '"Uaj-14^— 

lu 

-11+- 

14 

-Ht- 

00 

-00- 

Uy 

”wV" 

OwUO 1 1 
-6 “Mo0w0'2~ 


1 4-j, -U- 

• 

t * U' 

i • u 


um0140 ly Id 

0yui4H 7 2-li 

1 « 16 
~£iuu I 64 ■ 7 2 1 1 
Uyyl47 72 II 


lO Id 00 Ou OwOtoOO 

7-2—1 i -OV uii O "OwOvOO 

1« l6 C|0 uO Q^wk^Ou 
fi M 00 iiu y usaQouO 

72 II 00 yy 0 OyClwQO 


00 UyOyOO 22343|042S|2 

OuUtfOl 04o6o4o6i)&04 — 

iiwOyu2 CuOuUOOOiiyyO 

OwJteOH Cw0022 OOOOl^ 

0‘ijyiii6 3 I Od 2 b I 2 d7|^ B 

— 

0ti0y07 Cy Jy OO 3 COOOO 
— ■ ' ou -iw 1 V— 'Bwii^wiOOOvVo — 

Uii.vyll OmOOIo wuOo24 


u*«0yl2 OyOy OOQOtiUCii 

UJOuiO ” 

tiy0034 


Ttsrwu 

LlNt 

card 





U^uu&S dw0;ida00Ul3^ 

.— — — - '-- - y M " wwOwiii^wOG«^ 1 

uwSw!*/ (iwUiiJU0SU<i^3 
. — ■ — irwOtfvujtft^ t 3 ^ 

UW<Jm 61 4l^Uii34ifc}0«iWlHw 
— uy u w6 l|}««Uyyii3ii^il/ 1 ■-~ 

Oww^63 jwO ^wtiGy^iw^ 

— • — — ~— - — ijyu«6H • y y Cpy Jy D*iU 1 j3 — ~ 
yuwy^ii CyOwyuCyy^y^ 

— ■ ■■ OtfWw6» — CyO«wU£>«iwi*Hi— - 

Uwiiy67 OwGyijyOyii^y^ 

— wuuy7w~ • Crw&y w%iQ w w 1 w 

iiuOy71 GyOyOyQtiy^lO 

— uyyy72 • uvG«^yuOw-ijMi 

— <jc;.jw7*t “ 'tjyOuuuOuu* 14 — 

Uw^y/b CyUJyyjCail^ 

uy»jy76 v vu w jy Ouw i 1 & — 

y**Uy77 Cyy*««OyGyul 1^ 

.— . ^«*Cywy'Jyyll7 

Owi^lyl ywUy<^uCyyi2y 

• '• ■■ w«.i«lu2 Uy OyyuGuj 1 2 1 — 

iiy»«ly4 ywuywwQyyl22 

. O'^OuvuJy a 1 24 — 

uyulub wwGuyyGyyl2^ 

' C y u*ij)«0yo 1 2S 

OwJlG7 0«OyyUi)Uyl26 

uw^lii O^Qyw«iOwul4w 

— 1 1-^ - OviijyvuGGu 1 3 1— 
yyyl IJ yyCyyUSyiilG^ 

uy;;lli * JrfyOwy'iOOywGl*— “ 

yy^l IG gyOtiUyyuJuSS 

— — — tfwvl 1 ^ — wwt/Mt/wu'igwJ? 4— ■ 

gyyll7 OyOyJy2w>iy7*t 

Owwl2g OuO vU^iOG Wy 7 

«Jwyl2( Oy CiOOuyy g w 7 6 

wwgi22 • iiy 0wyi»GgygH4— — 

Gwtal23 

— •■ ■ ■ gwi'l 2-4 — VwugvvOOviyb^-^^ 

U*tf^l2b OyUy^^uwUwbw 

— —'- uwwl2* — vy Oyy vOggy^S— >- 

4iwwl4/ OyCyJgOgww72 

..-. -*iw^l3y- OygyygyGgw77 — - 

Ow^l Ji yygygwGyguMl 

^,,-■1.. — u vv^i2 G«iiy0M0ygv5*^*— 

Uwtol33 y y Oy U g 0 y «i 1 3 

Gwv^3*l'' w^g*lg*iOGwy 4g - 

gyvl3b w<-*uyggywgg6l 

— . — y u V I 3 6 yy t/y *J g 3 Uv U ^ 2 

ywyl37 u*jgygg*j'gvgo3 
— www 1 *lu — Oy 0 ggGuG gg^ 

uw.^i4t ywuwyyC^yw^S 
• • uy^l*i2 gyi)«fyyuuyg66 


- 6100- 
g|33 
"tt |-3S— 
0uS3 

Ob<40 

-tiei— 

6102 

-6103 

Cioi 
-616*- 
0106 
-6107- 
6110 
6 1 1 4- - 
6112 


0130 
— tjl3 • — 
6132 
— 6yS-l— 
OySS 
—60-63— 
oo?** 
-wu7*- 

6u76 

-Oo***- 

OvlH 

— oo62 — 

6650 

-yyH*-. 

6o72 

■ 6o7 7 — 
Coll 

-W6»- 

OlS" 
- 6660 — 
006 1 
- -0062 — 
0y63 
-Vo***^- 
6065 

■ -Ou66 . 


—at Si On, -j 

SlrlUARC OHAK OPLN 

--square -orak-cuose- 

POUNd SlIiN 
SPACE ■ 

B 

_£ 

0 


-PRA+f-ett»*E 

MINUS 

P C US - 

LESS Than 

equal- SION 

GREATER than 

-ANPCRSANO 


pran Open 
colon 

-quest HJn- HaH« 

BANG char 
-C-0 H Ma 

back Slash 


A-10 



^ t *4 3 0wt)J0003Uii»47 

UwOuOo Jiiww7 i 

jl*i6- - ww0wwwQ0Uw*l7 -* - 
«l47 ttwuwC10uwww73 

i I ^wO*iuuOwwuS7 — 

jiSl 3w£|«i3u0iii/wS* 

- 0*^uwUti30w«i*l2 ‘** 
ilBJ C*uA^ ua3 *iu 1 3 7 

.. 0^^«>3ud«jwwww'~ 

;l&i &mOuQ 1. uutawl3 

,IBb a^O^vuHul — 

.Ibfr 

• ib/ ww0«i3i Wtfuii36‘ 

M w u w I iiQ 2m u H w ' 
i 6 1 ~ uwu'^CiUtiu 1 uu2 - - 


LNU &KROrtb S UONt 


-e^oH — 


oa*7 • 

■ fa0 7 0 > 
0071 • 

0«73' • 

00^^ • 

SI 37 « 

LiSTtH- 


-OUOTt h^KK- 

senicOLON 


HP 2100 EBCDIC -> ASCII Conversion Programs 
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C> I U It i 

T“00004 

IS OH CA»««1'1 USING 00413 BLKS R-0073 


4001 

ASHB/ 




0002 

♦ 





0003 

• THK SUBKOUTINC 


FOBMAT 

0044 

• 





OOOS 

• THE CALLIHC SEQUENCE ISi CALL I BNHPO I BH I / 1 BH2< HP>'^ 


00»« 

♦ 

HHEREi IBHl 

- THE HOST SIGNIFICANT PART OF THE IBN REAL HQRB 

0007 

* 


IBHl 

-THE LEAST SIGNIFICANT PART OF THE IBH 

REAL WORB 

0 00 8 

1$ 


HP - 

THE REAL WORD IH WHICH THE RESULT IS TO 

BE STORED 

0009 




IN HP FORHAT 


OOlO 

* 





001 1 


HAH 

IBNHP 



0012 


EHT 

IBNHP 



0 013 


EXT 

.EHTR 



0 0.14 

* 





0015 

IBHi 

BS8 

1 



OOlfc 

1BH2 

B8S 

1 



001 7 

HPl 

BSS 

1 



0018 

* 





0019 

IBfIHP 

. NOP 


EMTRV/EXIT POINT 


0 02 0 

9 





0 02 1 


JSS 

• ENTR 

GET ADDRESSES OF PARAHETERS INTO 


0022 


DEF 

IBHl 

IBHl, 1BH2, AND HPl 


0023 

« 





0 02 4 


LDA 

HPl 

SET UP THE ADDRESS OF THE SECOHD 


0 025 


ISZ 

A 

HALF OF THE HP REAL WORD 


002b 


STA 

HP2 



0 0 2 7 

9 





O02C! 


LOA 

I8N1 . t 

GET FIRST PART OF IBH REAL UORD 


0 02 9 


AHO 

•B077400 

NASK OFF THE EXPOHEHT 


0 0 2 0 


ALF 

. ALF 

SHIFT TO LOWER 8 BITS OF A 


003 1 


ADA 

IBIAS 

RENOVE IBH EXPOHEHT BIAS OF S4 


0032 


ADA 

A 

QUADRUPLE EXPOHEHT TO HAKE IT 


0033 


ADA 

A 

A POWER OF 2 


0 03 4 


SSA 


SKIP IF POSITIVE EXPOHEHT 


0 035 


JNF 

HEGEX 

JUHP. IF HEGATtVE EXPONENT 


0038 


ALR 


POSITIVE EXPONENT -- ROTATE IT 


0 03 7 


JNP 

STEX 

1 BIT RIGHT AHD STORE 


003 3 

H£GEM 

RAL 


NEGATIVE EXPOHEHT -- SHIFT IT 1 


0039 


AND 

•B00037C 

NASK OFF JUST THE EXPOHEHT 


0 04 0 


S2A 


.( SKIP IF- EXACTLY ZERO) 


004 1 


ZOR 

>800000 1 

PUT IN SIGN SIT 


0 0 •) > 

?TEX 

STA 

TEMP 

STORE THE EXPOHEHT TEHPORARILY 


C 0 4 3 

9 





0044 


LOA 

IBHl , I 

GET FIRST PART OF IBHREAL WORD 


.0 04 3 


RAL 


ROTATE IT LEFT 1 BIT 


0046 


AND 

>800000 1 

NASK OFF HAHTISSA SIGH BIT 


004 7 


STA 

a 

STORE IN 6 REGISTER 


(>04 8 

9 





0049 


LDA 

I8H2. I 

GET SECOHD PART OF IBH REAL WORD 


0050 


ARS 


DROP LEAST SIGNIFICANT BIT OF MANTISSA 


0051 


AND 

>8077777 

AND CLEAR THE UPPER BIT 


0 03 2 


S2B 

i RSS 

SKIP If HAHTISSA IS NEGATIVE 


0053 


JNP 

*♦2 

DOHT COHPLEHEHT IF HAHTISSA POSITIVE 


0 05 4 


CNA 

, IN A 

HAHTISSA NEGATIVE. COHPLEHEHT 


0055 


AND 

>8000377 

GET LOWEST EIGHT BITS 


V 0 5 8 


ALF 

, ALF 

PUT IN UPPER PARI OF WORD 


0 05 7 


tOR 

TEHP 

OR IH THE EXPOHEHT 


0 0S8 


STA 

HP2/ I 

PUT IN SlCOHD halt of- HP REAL UORD 



A-13 



i>05'J 





ooeo 


LOA 

IRH2.i V 

,6ET SCGOHD PART OF IIH RIRl. «M» j 

0-J61 


AMD 

»Bi7740«f? 

'HA8K OFF UPPER B BIT8 1 

06b2 


AtF. 

ALF 

ROTATE TO LOUEF 8 BITS 

0063 


STA 

TEMP ^ 

8TBRE TEHPORARILT ; ; V ; 

0064 


LBA 

ISHl , 1 

GET FIRST PART OF IBM REAL UORP ' 

006S 


AND 

-B000377 

HASK OFF LOHER fl BITS 

0066 


ALF. 

ALF 

ROTATE TO UPPER B BITS 

0067 


lOR 

TEMP 

OR IH THE OTHER PART OF HAMTISSA 

0068 


ARS 


GET RID OF THE LOHER BIT 

0069 


AHO 

-B077777 

AND CLEAR THE UPPER BIT 

0070 


SZB. 

RSS . 

SKIP IF THE MANTISSA IS. NEGATIVE 

007 t 


JMP 

*♦2 

DOHT COHPLEHEHT IF MANTISSA POSITjIVE 

007 2 . 


CHA 


COMPLEMENT UPPER PART OF MANTISSA 

0073 


STA 

HP I, I 

PUT IH FIRST HALF OF HP REAL RORO 

0074 

« 




0075 


JHP 

I8RHP<I 

RETURN TO THE CALLING PROGRAM 

007 6 

* 




007 7 

• 




007S 

A 

EQU 

0 


007^ 

B 

EOU 

1 

' 

OOCO 

IB IAS 

DEC 

-64 


ooe 1 

TEMP 

HOP 



0 0 e 2 

HP2 

ess 

t 


008 3 


EHD 
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FTH4/L 

SUBROUTINE E2B< I B > L lA > ' . . 

INTEGER EBCASC(2SG> 

DIMENSION 1A< 1 > 

DATA EBCASC/0«l/2>3>0i9i0#127<0^0i0ill.l2.13.i4<15ilS<17<lt<0. 

0« 0< 8iO/24,2S^ 0,0<0i 0/0/ 0.0,0< 28<0/D. 0/ 2 3/27/ 
0/0/0/0/0/5/6/7/0/0/22/0/0/30/0/4/0/0/0/0/ 
20/21/0/2 6. / , 32/0./ 0/. 0/0/0/0/0/0/0/0/46/60/40/43/0/ 
38/0/ 0/ 0/ 0/0/0/ 0/ 0/ 0/33/ 36/ 42/ 41 /S9/94/ 45/ 47 / 0/ 0/ 
O/O/O/O/O/O / 124/44 / 37/95 / 62/63/0/0/* 0/0 / 0/0/0 / 0/ 
0/96/58/35/64/39/61/34/0/97/ 

96/99/ lOD/ 101/ 102/ 103/ 104/ 105/ 0/ 0/ 

0/0/0/0/0/106/107/108/109/110/ 

111/112/113/114/0/0/0/0/0/0/ 

0/ 126/ 1 15/ 116/ 1 17/ 1 18/ 119/ 120/ 121; 122/ 


0/0/0/91/0/0/0/0/0/0/ 
O/O/O/O/O/O/O/ 0/0/93/ 
0/0/123/65/66/67/68/69/70/71/ 
72/73/0/0/0/0/0/0/125/74/ 
75/76/77,78/79/80/81/82/0/0/ 

0/ 0/ 0/0/92/0/83/84/ 85/ 86/ 

87 /88/89/90/0/ 0/0,0/ 0/ 0, 
48/49/50/51/52.53/54.55/56/57/ 
0 / 0 / 0 . 0 / 0 / 0/ 


DO 7 1=1/ LIA 

INDEXl * IAND< ISHIF< I A< I )/ -8), 177B > + 1 
INDEX2 = IAND< IA< I ) / 177B ) + I 
7 IA<I) = IOR< ISHIF<EBCASC< INDEXl >/ 8 >/ EBCASC< INDEX2 >> 
RETURN 
END 
END» 
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A-2. 


Conversion Programs (Specific) 

• 1965 KSC Rawinsonde Data Conversion Program 

• 1974 Vandenberg Rawinsonde Data Conversion Program 

• 1964-1970 Jimsphere Data Conversion Programs 
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1965 KSC Rawinsonde Data Conversion Program 
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FTN4/L 

PROGRAM SOUND 

DIMENSION IBUF(40 >. OBUF( 40 ) «ISIZE<2> 

DIMENSION NAME(3>< I0C6(2SG) 

INTEGER OBUF 
DATA I99/2H 9/ 

DATA ISIZE/-1,40/ 

DATA 1ST/2HST/ 

DATA NAHE/2Ht.S.2HDB/2H65/ 

C** CREATE DISC FILE TO STORE CONVERTED SOUNDING 
CALL CREAT( IDCB, lERR. HAHE< ISIZE. 3) 

C SET IL TO NUMBER OF UORDS TO BE WRITTEN » 39 

IL = 39 
NC * 1 

WRITE(6i320 ) 

56 READ( 8, 15 ) OBUF 
C I F( OBUF( 2 > . HE . 1ST > GO TO 56 

C HC=NC +1 

C IF<NC. LE. 12 ) GO TO 56 

WR1TE<6,310) < OBUF( N). N=l, 40) 

CALL CODE 

WRITE (IBUF,15) ( OB UF < N ) , M = 1 , 40 ) 

CALL WRITF < 1 D CB , I E RR . I B UF . I L ) 

88 DO 10 1=1.5 

HC=NC+1 

READ<8. 15 ) OBUF 

15 F0RHAT(40A2) 

WRITE<6.310) ( OBUF< N). N=l. 40) 

CALL CODE 

WRITE (IBIJF.15) ( OBUF< N),M=1, 40 ) 

CALL WRITF < I D CB , I E RR . I B UF . I L ) 

10 CONTINUE 

16 READ(8,20> lALT.IWD.IWKTS.ITEHP.lTS.IDPT.IDS.IPRESS.IRH.IAB, 

1 1 DEN . I R . I VS . lUS 

20 F0RHAT<I6.3X.I3.2X.I3.3X.I2.A2.4X,I2.A2.3X,I5.3X,I2.4X.I4,1X. 

1I5..3X. 13.. 2X-. I3-. 2X-. 13.. 5X) 

CALL 1SIGC<ITEMP,ITS.IDPT.IDS.TEHP,DPT> 

PRESS = IPRESS/10. 

AB = IAB/100. 

DEN = IDEN/10. 

WRITE(6.350) IALT,I«D.IWKTS.TEHP,DPT.PRESS.IRH,AB.DEN.IR.IVS,IMS 
350 F0R«AT(1X.I6.3X.I3.5X.I3.2X.F5.1,3X.F5.1.3X.F6.1/3X.I2.3X. 

1F5.2.2X.F6.1.1X.I3.1X.I3.1X.I3) 

CALL CODE 

WRITE<IBUF.350) I AL T, lUO.IWKTS. TEMP. DPT. PRESS. IRH.AB. DEN. 

1 IR.IUS.IWS 

CALL WRITF < I D CB . I E RR , I B UF . I L ) 

IF< lALT .LE. 1 9500 ) GO TO 16 

17 READ(8. 15 ) OBUF 
IF<0BUF<40) . NE . 199) GO TO 17 
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MRITE(6/310) < OBUFC H=1 / 40) 

C^LL CODE 

WRITE, < IBUF, 15 ) < OB UF < N ) , N = 1 , 40 > 

CALL WRITF ( I D CB , 1 E RR . I B UF , I L ) 

WRITE! 6.320 ) 

DO 18 1=1.2 

READ! 8 . 15 ) OBUF 

WRITE!6.310) ! OBUF! N ) . N= 1 . 4 0 ) 

CALL CODE 

WRITE !IBUF.15> ! OB UF ! N ) . H = 1 > 40 ) 

CALL WRITF ! I D CB . I E RR . I B UF . I L ) 

18 COHTIHUE ' 

21 READ!8.19) I AL T . I WD . I U KT S . I TEMP . I T S . I DP T . I DS . I P RE SS . I R H 

19 F0RMAT<I6.3X.I3.2X.I3.3X.I2.A2.4X.I2.A2.3.'<.I5.3X.r2) 

PRESS = IPRESS/10. 

CALL ISIGC! ITEMP. ITS. IDPT. IDS, TEMP. DPT) 

WRITE! 6. 351) lALT.IWD. lUKTS. TEMP. DPT. PRESS>IRH 
351 F0RMAT!1X.I6.3X.13.5X.I3.2X.F5.1.3X.F5.1.3X.F6.1/3X.I2) 

CALL CODE 

WRITE! IBUF.351 ) I ALT. lUD.IblKTS. TEMP. DPT. PRESS. IRH 
CALL WRITF ! I D CB , I E RR , I B UF . I L ) 

IF! I ALT .LE . 1 9500 ) GO TO 21 
86 REAoVs . 15 > OBUF 

IF!0BUF!2).ME. 1ST ) GO TO 86 
WRITE! 6,320) 

URITE!6.310> ! 08 U F! N ) . N= 1 . 4 0 ) 

CALL CODE 

WRITE !IBUF.15) ! OB UF ( N ) . N = 1 . 40 ) 

CALL WRITF ( I D CB . I E RR . I B U F . I L ) 

I F! HC . GT . 700 )G0 TO' 90 
GO TO 88 

320 FORMAT! IHl ) 

310 FORMAT! IX . 40A2 ) 

90 CALL CLOSE! IDCB. lERR) 

EHD 

SUBROUTINE ISIGC!ITEMP. ITS. IDPT. IDS. TEMP. DPT) 

DIMENSION ICHR!10>. INM!10) 

PATA ICHR/2H! .2HJ .2HK .2HL .2HM .2HN .2H0 .2HP .2HQ .2HR / 
DATA IHM/2H0 .2H1 .2H2 .2H3 .2H4 .2H5 . 2H6 .2H7 .2H8 .2H9 / 
DO 10 1=1 . 10 
A = I - 1 
B = -1 . 

IF!ITS . EQ . ICHR! I ) ) TEMP =! F LO AT ! I T EM P ) + A^IO.) * B 
IF! IDS ; EQ . ICHR! I ) > DPT = ! F L 0 A T! I DP T ) + A/10.) * B 
IF! ITS . EQ . INM! I ) ) TEMP =! FLOAT! I TEMP ) + A/10.) 

IF! IDS . EQ . INM! I ) ) DPT =! FLOAT! I DPT ) + A/10.) 

10 CONTINUE 
RETURN 
END 
EHD» 
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1974 Vandenberg Rawinsonde Data Conversion Programs 

• IBM 360/44 Variable Length Fixed Length IBM 370 

• Data Selection Program 

• IBM 370 EBCDIC -> ASCII (See pages A-3 through A-5) 
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LIJC OBJECT CODE AODRl ADDR2 STMT SOURCE STATEMENT 






1 


PRINT 

NOGEN 





2 

HPRTRO 

READY 


J00014 

A7F0 

C09E 

0009E 

12 

BRANCH 

a 

OPEN 

O.UOOIB 

5820 

1000 

00000 

13 


L 

2.0( ,lt 

jouoic 

5830 

lOOA 

OOOOA 

14 


L 

3>4I ,1) 





15 


GET 

TAPE,(2» 

J0UJ2C 

IBU 



20 


SR 

Itl 

J0002E 

3010 

3000 

00000 

21 


ST 

1.0( ,31 

OJOJ32 




22 

RETURN 

OS 

OH 





23 


RET 



U0J064 




31 EOF 

DS 

OH 

000084 

96F0 

C013 

00015 

32 

01 

BRANCH4-1,X*F0* 





33 

CLOSE 

ITAPE) 

000092 

4110 

0001 

00001 

39 

LA 

1,1 

00009O 

5010 

3000 

00000 

40 

ST 

1,0( ,3) 

00O09A 

47F0 

C032 

00032 

41 

B 

RETURN 


00J09E 



43 OPEN 

DS 

OH 

Ju009E 

1821 


44 

LR 

2,1 

UOOOAU 

940F C015 

00015 

45 

NI 

BRANCH«-1,X'0F* 




46 

OPEN 

(TAPE) 

OUOUAE 

1812 


52 

LR 

1,2 

000080 

47F0 coia 

oooia 

53 

B 

BRANCH+4 


55 TAPE DCS OSORG=PS t M ACR F = 6H i UDNAHE*S ASTAPE , EDO AD»E13F 

109 END 
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COMPILER OPTIONS - NAME* HA I N , OPT-00 , L I NECNT»5% t S IZ E«0200K i 

SOURCE, EBCDIC. NOLISTt'NOOECK tLOAO. MAP, NOEOir* I D.NOXREF 
ISN 0002 DIMENSION IMNI12) 

ISN 0003 LOCilCAL*! lOATAI 20» , I SUFI 2500 J 

ISN 0004 DIMENSION PRE SS P I 78 ) , PR ESS^ ( 7 8 I , AL TP ( 73 I , AL TR( 78 » , TEMPP f 78 » , . 

1 rEMPR(78),DPTPI7B) ,DPTR(78>,W0PI78),M0R(78),HSP(78), 

I WSRI78) 

ISN 0005 INTEGER42 YR , MO, DA, HR ,08, IND, PRESS, TEMP , OPT , WD ,WS, NLE VEL 

ISN 0006 INTEGER HT,STN,EOF 

ISN 0007 EQUIVALENCE ( I 8UF ( 5 I , NLE VELI , II 8UF ( 9 I , STN I , It BUF I 13 I , YR I , 

1 I IdUE ( 15 ) ,M0) , I I8UF (17) ,OAi , ( I BUF ( 19 ) , HR ) , 

I (IdUF(25),0B), (lOATAm.INO), I I DAT AI 3) .PRESS » , 

I IIDATA15),HT), I I DAT A( 9 ) , TEMP ) , I I D AT Al 1 1 ) , DPT ) , 

1 I IDATAI 13) ,WD) , I IDATAI 15) ,WS) 

ISN 0008 DATA IMN/4HJAN ,4HFfd ,4HMAR ,4HAPR ,4HMAY ,4HJUN ,4HJUL ,4HAUG t 

14HSEP ,4H0CT ,4HNUV ,4HDEC ! 

C ♦♦ CALL TAPE READ ROUTINE 
ISN 0009 ICNT = 0 

ISN 0010 10 CALL MPRTROIIUUF.EOF) 

ISN 0011 IFIEUF.EQ.l) GO TO 99 

C *♦ CHECK FUR PldAL LEVEL 

C CHECK FOR RAWINSUNOE DATA 

ISN 0013 IF (Ud.LT .l.UR .JB.GT .2 ) GO TO 10 

C ** CHECK FOR SURFACE LEVEL 
ISN 0015 DO 15 1=1,20 

ISN 0016 N = I + 80 

ISN 0017 lOATAII) = ISuFiN) 

ISN OOld 15 CONTINUE 

ISN 0019 IFIINO.NE.O) GO TO 10 

C ♦♦ COMPUTE NUMBER OF DATA LEVELS 
ISN 0021 ILEVEL = NLEVEL 

■-ISN 0022 LEVELS = ILFVEL/20 

ISN 0023 IFlQB.EQ.l) LEVELP = LEVELS 

ISN 0025 IFIOd.EW.2) LcVELR = LEVELS 

C PROCESS ALL LEVELS OF DATA 
ISN 0027 DO 20 1=1, LEVELS 

ISN 0028 I I = 1*20 + 61 

ISN 0029 JJ = I I ♦ 19 

ISN 0030 K = 0 

1 SN 0031 DO 25 J=I I , J.I 

ISN 0032 K = K + 1 

ISN 0033 IDATAIK) = I8UFU) 

ISN 0034 25 CONTINUE 

ISN 0035 IFIUB.EQ.2) GO TO 88 

ISN OJ37 PRESSPII) = PRESS 

ISN 0033 PRESSPII) = PRESSPin/lO. 

I SN 0039 ALTP I I ) = HT 

ISN 0040 TEMPPI I ) = TEMP 

ISN 0041 TEMPP(I) = ITEMPPI I )/10.) - 273.16 

ISN 0042 WDPI I ) = WD 

ISN 0043 WSPI I ) = WS/IO. 

ISN 0044 DPTPI I ) = OPT 
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If 


ISN 

0045 


IDAP > OA 

ISN 

0046 


IHRP « HR 

ISN 

0047 


GO TO 20 

ISN 

0043 

33 

continue 

ISN 

0049 


PKESSRI 1 1 « PRESS 

ISN 

0050 


PRESSRin = PRESSRin/lO. 

ISN 

0051 


ALTRII) = HT 

ISN 

0052 


TEMPRIl) = TEMP 

ISN 

0053 


TEMPRIIJ = ITEMPRID/IO.) - 273. 

ISN 

0054 


MORI I 1 = WO 

ISN 

0055 


hSRI 1 ) = WS/10. 

ISN 

0056 


OPTRin = OPT 

ISN 

0057 


I OAR = OA 

ISN 

0050 


IHRR = HR 

ISN 

0059 

20 

CONT INJE 

ISN 

0o60 


ISTN = STN 

ISN 

0061 


IVR = VR 

ISN 

0062 


I MO = MO 

ISN 

0063 


lOA = DA 

ISN 

0064 

C ** 

I HR = HR 

WRITE DATA RECORDS TO TAPE 

I SN 

00o5 


IFIOli.EO.H GO TO 10 " 

ISN 

0067 


IFia8.NE.2) GO TO 10 

I SN 

0069 


ICNT - ICNT + 1 

I SN 

007 0 


IF( I ilAP.Nt. lOAR.OR.IHRP.NE. IHRR I 

ir.N 

0072 


I H ( HRP .N£ . 12 » GO TO 10 

ISN 

0074 


I F{ lCNT.LI.il 1 GO TO 10 

ISN 

00 76 

c 

ICNT = 0 

COMPUTE PI0AL PRESSURES 

ISN 

•)0 J 7 


lEIPRESSPIlI .E0.-.1.AN0.ALTP( 1). 

1 SN 

0079 


N = 1 

I SN 

0080 


00 210 I=2,LEVELP 

1 SN 

ooai 


IFIPRESSPUl.iNE.-.ll GO TO 220 

I SN 

0083 


N = N F 1 

I SN 

0084 


GO TO 210 

1 SN 

0005 

220 

IFIN.EQ.l) Gil TO 210 

1 SM 

OOiU 


J = I - N 

ISN 

0000 


X = ALTP(I) - ALTPIJI 

ISN 

0089 


Y = \LUr,(PRESSPI Jll 

ISi'l 

0090 


Z = ALOGI PRESSPI I I » 

ISN 

0091 


C = Y - Z 

ISN 

0092 


NN = N-l 

IS'N 

009 3 


00 32 K=1,NN 

ISN 

0094 


A = ALTPIJ+KI - ALTPIJI 

ISN 

0095 


B = A/X 

ISN 

0096 


0 = B*C 

ISN 

00v7 


E = Y - D 

ISN 

0090 


PRESSPIJ+KI = EXPiei 

ISN 

0099 

32 

CUNT INUb 

I SN 

01 00 


N = 1 

ISN 

OlOl 

210 

C 

CONTINUE 

COMPUTE RAUB ALTITIUOES 


PRESSAI II 
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ISI^ 

0102 


N ■ 1 

ISN 

0103 


00 320 I «1*LEVELR 

ISN 

0104 


IFIAUTRin.NE. -l.rCO TO 330 

ISN 

0106 


N « N ♦ 1 

ISN 

0107 


60 TO 320 

ISN 

OlOU 

330 

IFIN.EO.l) 'GO TO 320 

ISN 

QUO 


J = I - N 

ISN 

0111 


X = ALOGIPRESSRUI ) 

ISN 

0112 


y » ALOGlPRESSKll > t 

1 SN 

0113 


Z = X - Y 

ISN 

OlH 


A ? (ALlPm - ALTRUM 

IbN 

Oils 


NN = M - 1 

ISN 

0116 


00 33 K = l,NN . 

ISN 

OIL? 


6 = X - ALQGIPR£SSR(J-*-Kn 

ISN 

0118 


C = B/Z 

ISN 

0119 


0 = A ♦. C 

ISN 

0120 


ALTRIJtKI = 0* ALTRIJI 

ISN 

0121 

33 

CONTINUE 

1 SN 

0122 


N = 1 

1 SN 

0123 

320 

C 

CUNT INUE 

COMPUTE PIBAL' TEMPERATURES 

ISN 

0124 


IFI ALTPI 1) .EO.ALTRI 1) ) TEMPPm = TENPRIl) 

1 SN 

0126 


DO 264 I =2,LEVELP 

ISN 

0127 


DO 263 R=2,LEVELR 

1 SN 

0123 


IFIALTPI n .Eg.ALTKlKI) TEMPPII) = TEMPRIKI 

ISN 

0130 


IFl ALTPI 1 ) .GT .3500. I GO TO 265 

ISN 

0132 


IFl ALTPI n .EQ.ALTRIK) ) GOTO 264 

I SN 

0134 


IF! ALTPI 1 » .GT .ALTR(KI) GO T3 263 

ISN 

0136 


A = ALTRIKl - ALTRIK-1) 

ISN 

0137 


0 = ALTPII) - ALTRIK-U 

ISN 

0130 


C = b/A 

I SN 

0139 


D = TtMPRlK-1) - TEMPRIK) 

ISN 

0140 


E = 04C 

ISN 

0141 


TEMPPIII = TEMPRIK-U - £ 

ISN 

01^2 


GO TO 264 

ISN 

0143 

263 

CONTINUE 

I SN 

0144 

264 

CUNT INUE 

ISN 

(1145 

265 

CONTINUE 

ISN 

0 1 46 


LPN =1-1 

1 SN 

0147 


vIRlTF. 16,421) 

I SN 

Ol4J 

421 

FORMATI//,lH ,17HINTERP0LATE0 DATA,//) 

ISN 

0149 


WRITE (0,001) ■ 

ISN 

0130 

001 

F0RMAT(2YHTEST N0R 03717 04834 0-24HR) 

ISN 

0151 


WRITE (0,802) 

ISN 

0132 

002 

F0HV.A1 (20HRAW1NS0N0E-PIBAL RUN) 

ISN 

0153 


WRtTE{0,8O3) 

I SN 

0154 

303 

FOkMAT121HVANUEN0EkG AFB, CALIF) 

ISN 

0155 


WRITE(0,0O4) lOA.IMMIMO), lYR 

ISN 

0 1 36 

004 

FOR'IAr ( 7H1200Z , t 2 , IX , A4 , 2H 1 9 , 1 2 ) 

IbN 

0157 


wRirE(6,931) lUA, IMN( IMO) , lYR 

ISN 

0150 

931 

FURWATIIH , 12, 1X.A4, IX, 12) 

ISN 

0159 


WRITE(8,0O5) 

ISN 

0160 

005 

FORMATIllHASCENT NBR ) 

ISN 

Ol6l 


WR1TEI8,701) , 

ISN 

01o2 


WRITE (8, 702) 

ISN 

0163 


WRITE (6,701) 

ISN 

0164 

701 

FURMAT(2X,31HALT OIR SPO TEMP DPT PRESS) 

ISN 

0165 


WR'ITE(6,702) 

ISN 

0 1 66 

702 

FORMAT(3X,29HFT DEG KTS OEG C MBS) 

ISN 

0167 


DO 7 /9 1 = 1, LPN 

1 SN 

0160 


lALTN = ALTPII) ♦ 3.28084 

1 SN 

0169 


I wDN = WOPI!) 

ISN 

0170 


IWSN = wSP( I ) * 1.94254 

ISN 

0171 


D p r N = 0 p T p n ) 

ISN 

0172 


TEMPi'i = TEMPPII) 

ISN 

0173 


PRESSN = PRC 5SP( I 1 

ISN 

0174 


WRITE (0, 703 » I ALTN, I WON, I WS N, TEMPN, D PTN, PRE SSN 

ISN 

01 75 


WWITE(6,703» lALTN, I WON, I WSN , TEMPN, DPTN, PRE SSN 

ISN 

0 176 

70J 

format ( I6,1X,13,1X,13,IX,F5.1,1X,F5.1,1X,F7.2) 

ISN 

0177 

779 

CUNT INUE 

1 SN 

0170 


GD TO 10 

1 SN 

0179 

99 

STOP 

ISN 

0100 


END 
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1964 - 1970 Jimsphere Conversion Programs 


• UNI VAC 1108 Data Reduction 

• UNI VAC 1108 BCD ASCII (See pages A-6 through A-11) 
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■mil II 


iiiiii iiiiiiiiii 


■III mill I 


■IIIIII ■III■■I■■IH■ 


in IIIHIHM 



tuJuu 

CUUi> 

wu ^ 0 ^ 
L u 1 0 ^ 

*UlA6N0SnC* .. THE 

I* 

2 » 

3» 

; NAHE a appears Im a dimension qR TTPt statement but 
dimension IDATA(3ou) •WD|‘«(t<t> 
dimension A( 8 ) 

IS never referenced* 

000000 

000001 


READIbflCCOI NFlLES 
DO SO NF*I tNFlUr.S 

OQOOOl 

oo'ooo? 


cwl 1 2 

S> 


writeia, icsj) nr 

00C023 



... 6 * . 


00 HO NR*1,2u 

C0C033 


•M W i ^ 

7* 


CALL NTRAN(8«2i298, | D aT A f I ERR i 22 1 

000033 



8 * 

III 

IF( tERR.E^.-l ) f.O TO lU 

000013 


wCt 2 i 

9» 


IFI 1ErK.lt. -1 I call NTKAN|B,22I 

00 C 01 S 1 


w o 1 2 

10 *.... 


nda - is 

OOOOSS , 



II* 


DO 30 1*1,5 

000061 



, 12 * .. 


Encode tec, 1030 . wdih, inumi i ioATAfNox*7*Ki . k*i . a> 

0 Q 0063 


bOl37 

13* 


NOX*NDX*S(> 

odbioo“"T 



It* . 


CALL UTrArIV.I ,iH.rDIH,iErR.22I 

000103 . 


w w i 1 

15* 


IFINF.GC. 2 ) 00 TO 2S 

OqO||3 I 



1 6 « 


A'RITE 16. lOHO) ( AD 1 H ( K ) • K* 1 . 1 H | 

OcOllS 


<;ai tti 

17* 

lOVd 

FOKHATIlH , 1 HA 6 ) 

000127 ' 



lb* 

25 . 

CONT I NUF 

000127 


U J 1 bw 

IV* 

3u 

CONTINUE 

000127 



20 * 


CUNTINUF 

0 O 0 I 2 ? 



' 21 * 


Call ntran(8,7 , i .221 

000127 


OJiSS 

22 * 

... .. Sw 

CONTINUE 

000137 


Ww 1 b 7 

2 3* 


Call ntmanIv,9i 

000137 


^ i 6 V 

2 V* 


CALL NTRANI9,II) 

000113 

. . 

bUi 6 > 

25* 


STOP 

“ S0OI17 


w w 1 ^ 

2 ** 

1000 

FORmATIISI 

OOOIOJ 


w3 i fr 

27* 

Ib90 

fohhatisfio.i I 

f 000153 


iOltt 

26* 

lO&b 

FOKHATIlH .3HNF..15I 

0C0153 


»y 1 ^ b 

2V* 


End 

0C01S3 
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A-3. Interactive REEDA Programs 

• M0D3A : 

• M0D3B \ 

• METPL \ REED Program* 

• STAN5 ) 

• MIXH 

• JWSPL 

• J\VDPL 

• JIMPS 

• SKEW T (Version I & II) 

• PUFF 


♦These have been merged into the NASA/MSFC REED Diffusion 
Model Program Version I. 
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Program M0D3A 



ooo o o o nooooodo 


FTH4, L 

PROGRAH H0D3A 
C 


NASA/HSFC HULTILAYER DIFFUSION MODEL - H0D3A 04 HAY 1977 


COMMON BLOCK 

COMMON ALT( 31 ).AL1. COHHAX, COHCPK.DEGRAD. ADlR.DOSPKi El. CLDHT. 

IDIR( 31 >. I0PT< 3 ). ITIME. IDAY, MONTHt 2 ), lYEARi ISTIM. ISDAY, 
ISM0N<2 >. ISYEAR. I V2. JTOP . LAUHTD< 10 ) , LTIME. LT IM. LDAY. 
LM0H(2).LYEAR.LU.NUM.PI.PI0VR2,P143,PRESS(31).PTEMP(31), 
Q1.RADDEG.RAT0HC.CLDRAD/R2.R3.SAVEA(30>.SAVER(30).SIGA. 
SIGXO.SIGX.SPEED(31>.SQR2PIiSURDEN.SIGZOiSIGAP.S8.TEHP<31>. 
T0PSUR.TW0PI.ASP0.VPAR<18).CRTIME(31).DIST.YES.Y1.NUMRUN. 
YPOS. IFLGK5 ), ZB. ZZ. REFLEC, IRETRN 
LOGICAL LTIME 
INTEGER YES 

EQUIVALENCE < QC 1 . VP AR ( 1 ) > . < QC2 . V P A R< 2 ) ) , < Q C3 . V P AR < 3 > ) . 

<QT1.VPAR(4))/<QT2.VPAR<5)).<QT3,VPAR<6>>. 

<AA.VPAR<7)).(BB.VPAR<8)).(CC.VPAR<9)). 

<HEATN.VPAR<10>>i<HEATM.VPAR<ll)).<HEATA.VPAR<12)J. 

<PHCL.VPAR<13>).(PCO.VPAR<14>>.(PC02.VPAR(15)). 

<PAL203,VPAR<16)).(PN0.VPAR<17>).<GAMMAX/VPAR<18)) 


INPUT FORMAT STATEMENTS 

100 FORMAT < 12, IX. 2A2, 12) 

101 FORMAT <10A2) 

102 FORMAT ( I 4. S X I 2 . 1 X A 2 . A 1 . 1 X I 4 > 

103 FORMAT < I 4. 3X1 2. 1 XA2. A 1 . IX 1 4 > 

104 FORMAT ( I 6 . 1 X I 3. 1 XF 4 . 1 . F6 . 1 . F 6 . 1 , F 7 . 2 . 1 1 X F 7 . 2 ) 

OUTPUT FORMAT STATEMENTS 


200 FORMAT 

201 FORMAT 

202 FORMAT 

203 FORMAT 

204 FORMAT 

205 FORMAT 

206 FORMAT 

207 FORMAT 


(//7/'“t*.dB****NASA/MSFC MULTILAYER DIFFUSION MODEL - M0D3A* 
4X“04 MAY 1 977**** " > 

<//"ELdBNUHBER OF RUNS AND COMMON DATA FILE NAME “ 

“(e.g. 01, DATA)! E«,dJ_“) 

<5X“RUN *12" UILL USE DATA FILE "3A2) 

(//"|tcdFR|LdBESEARCH OR ^&dFP|Ld6R0DUCT I OH RUN: gidJ_"> 
<5X‘RESEARCH RUN" ) 

<5X"PR0DUCTI0N RUN" ) 

<//'“6«.dBT0P OF SURFACE LAYER(M): 

<.'/"E4dBSIGMA OF WIND AZIMUTH ANGLE: |fcdJ_“) 
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208 FORMAT 

209 FORMAT 

210 FORMAT 


211 FORMAT 

212 FORMAT 


213 FORMAT 

214 FORMAT 

215 FORMAT 
2,16 FORMAT 

217 FORMAT 

218 FORMAT 

219 FORMAT 


220 FORMAT 


221 FORMAT 

222 FORMAT 


223 FORMAT 


(7/-|t.dBLAUNCH TIME AMD DATE " 

0800 EST 01 MAY t976)i ) 

(SX/"LAUHCH TIME: " 4A2/SX "LAUNCH DATE: *6A2) 
(//"lidBLAUHCH VEHICLE ( |t.dFSH|t>dBUTTLEi " 
■|tdFTI£tdBTAN. |t.dFD|t.dBELT A-THOR g«<dF2g ttdB 91 4< " /I 6X 
"ItdFDI&dBELTA-THOR |tdF3|tdB91 4, * 

"EtdFM|fcdBIHUTEE6dFMEi>dBAN II): |6dJ_" > 

(SX"LAUNCH VEHICLE: "4A2> 

< • 1"80< IH* )/lX, 80< 1H*)/1X, 10< IH* >. 60X, 10( IH* )/ 
1X,10<1H*)-" HASA/MSFC MULTILAYER DIFFUSION MODEL - " 
‘M0D3A 04 MAY 1977 " . 1 0( 1 >/ 1 X - 1 0 ( 1 H * ) , 6 0 X , 10 < 1 H* > / 
IX, 80< IH* >71X, 80< IH*)/ 

"ORUN "12" USING DATA FILE "3A2/ 

•0*3A2,A1" LAUNCH VEHICLE") 

("OLAUNCH TIME:^, *14" E " A2 , 4 X " D ATE : " I 2 , 1 XA2 , A 1 , 1 X I 4 ) 

< "OPREDICTION TIME: *14“ E “ A2 , 4X " 0 A TE : ’ 1 2 , 1 X A2 , A 1 , 1 X I 4/ 

“ODATA FILE HEADER INFORMATION:") 

<*0<<<<0PEN ERROR "14", PROCESSING CONTINUES WITH " 

"NEXT RUN>>>>“ > 

<"0<<<<READF ERROR “14", PROCESSING CONTINUES WITH “ 
"NEXT RUN))))" ) 

(6X, 40A2) 

<"0"5X"TIME: "14" E"A2,4X 
"DATE: * 12, 1XA2, A1 , 1X14 ) 

< " 1"80< IHS >71X, 20< 1HS),4.0X, 20< IHS)/ 

1X,2 0(1HS),16X"S0UHDING“16X,2 0(1HS)/ 

IX, 20< IHS ), 40X,20< IHS )/lX, 80< IHS)//) 
("1"80(1HF)/1X,20<1HF),40X,20<1HF)/ 
1X,20C1HF),16X"F0RECAST“16X,20(1HF)7 
1X,2 0<1HF), 40X,20<1HF)/1X,80(1HF)//) 

(“OSURFACE DENSITY CGM/M**3): ‘F8.2) 

("OLAYER ALTITUDE DIRECTION SPEED TEMP 

“POT-TEMP D P TEMP PRESSURE*/ 

" NO. (FEET) (METERS) (DEGREES) (M/SEC) 

“(DEGREES CENTIGRADE) (MILLIBARS)") 

(2X12, 17, 2X15, 7X13, 5 XF 4.1 ,4XF4 . 1 , 4XF5 . 2 , 6XF4 . 1 , 6XF5 . 2 ) 


TYPE AND DIMENSION STATEMENTS 


INTEGER BLANKS,FILE(3 ),FDIGIT(50 ), RCHAR, VNAMES( 4, 5), 
RUNNUM,RA,F0,SDT,TE,ZER00,GETTD(3),CLDRI(3) 
DIMENSION IPAR(5 ) , VPARS( 18 , 5 ), I VNAM( 5 ), IDCB( 144 ), IBUF( 40 ) , 
IALT(31 ), DPTEMP( 31 ) 

DATA STATEMENTS 


C*** VPARS( 1-18) = SHUTTLE ( 1 9 - 36 )* T I T AH ( 3 7- 54 ) =DEL T A- THOR 29 1 4 

C*** ( 55-72 )=DELTA-THOR 3914 ( 7 3- 9 0 ) =M I NU TE M AN II 
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c 


DATA VP ARS/1 .521 923 E7, 6. 882968E6, 3.44 1484E6, 1.894794 173E9. 

8 .5692 951 6E8. 1 . 713859032E9. . 8522129891 i . 4880846, 

.37 5, 147 9. 7, 1062. 35, 1000.0, .1970, .22 34, .0316, .2791, 

. 0002, .64, 

5.4375 28E6, 2. 718?64E6.'l . 359382E6, 3.2625168E8,, 
1.631258 4E8,3.2625168E,8,.429580489,.5184223,' 

5 .0. 20 21 . 1 , 1010 . 55, 1000 .0 , . 1932, . 26 65, .0 222, 

.2819, .0002, .64, 

8.360685E5,9. 09811E4,2. 729434E5,2 .887598E7, 

3 . 142 2 9E6, 1 .8 85 3 73E7, . 9 22 1 56 , . 4 32 70 3 , . 54 , 1 766 . 0 , 

1000. 0 . 690 , 0, . 1866, . 20,55, . 01 56 ,. 339 i , . 0002, 

.50, 

1 .057 5 57E6, 1 .48 2923E5,3 .70 731E5.6 .7026 9E7, 

9 . 3986 16E6, 4 . 699308E7,.l . 245756 ,. 4 180947, 

0 .0 , 1 449 . 9 , 1000 . 0, 41 1 . 1 8, . 1866, . 2055 , . 0156, . 3391 , 

. 0002 , .50, 

4 .684 476E5 , 4 . 68 4476E5 , 1 . 1711 19E5, 2 . 8106856E7, 
2.8106856E7,2.8106856E7, .469982, .463333, 0.0, 

2055.9.2055.9.1000.0, .1866, .20 55, .0156, .3391, 

. 0002, .647 

C 

DATA BLANKS/2H /, RCHAR/1HR7, RA/2HRA7, F0/2HF0/, 

SDT/2HDT/ , TE/2HTE/, ZER00/2H00/ , NINE9/2H99/, 

CETTD/2HGE, 2HTT, 1 HD/, CL DR I /2 HC L , 2HD R , 1 H I / 

DATA FDIGIT/2H01,2H02,2H03,2H04,2H05,2H06,2H07,2H08,2H09,2H10, 
2H11,2H12,2H13,2H14,2H15,2H16,2H17,2H18,2H19,2H20, 
2H21,2H22,2H23,2H24,2H25,2H26,2H27,2H28,2H29,2H30, 
2H31,2H32,2H33,2H34,2H35,2H36,2H37,2H38,2H39,2H40, 
2H41,2H42,2H43,2H44,2H45,2H46,2H47,2H48,2H49,2H50/ 
DATA I VNAM/2HSH, 2HT I, 2HD2, 2HD3, 2HNH/ 

DATA VNAMES/2HSH, 2HUT, 2HTL, IHE, 

2HTI , 2HTA, IHN, IH , ; 

2HD- , 2HT , 2H29, 2H14, 

2HD- , 2HT , 2H39 , 2H14, 

2HHI .< 2HHH, 2HH ,2HII/ 

FIND THE LOGICAL UNIT NUMBER OF THE DEVICE TO BE USED FOR 
INPUT AND SET THE VARIABLE LU EQUAL TO IT 

CALL RHPAR( IPAR> 

LU = IPAR( 1 ) 

INITIALIZE SOME COHMON VARIABLES 

LTIME = .FALSE. 

YES = IHY 
PI = 3 . 141593 
PI0VR2 = 0. 5 * PI 
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PI43 = 1 . 

3333333 « PI 

TUOPI = 2 

.0 * PI 

S0R2PI 

SORT< TUOPI ) 

DEGRAD = 

PI/180. 0 

RADDEG = 

180.0/PI 

DO 2 1=1. 

3 

IOPT< I ) = 

0 

ZB = 0.0 
ZZ = 0.0 
REFLEC = 

1 . 0 


URITE THE HEADER OF THE CONSOLE 
HR ITE < LU , 200 ) 

READ IN THE HUNBER OF RUNS TO BE HADE AND THE FIRST FOUR 
CHARACTERS OF THE DATA FILE NAMES FOR THOSE RUNS 
C 

WRITE < LU,20n 

READ (LU.lOO) NUHRUN. F ILE< I ), FILE( 2 ) i IFOFF 
NUHRUH = MINOC MAXO< NUHRUN. 1 >. 50 > 

IF<IFOFF .GT. 0)IF0FF = IFOFF - 1 
IF<FILE<i) .NE. BLAHKS)GO TO 5 
FILE< 1 ) = 2HDA 
FILE<2> = 2HTA 
IFOFF =0 

5 IF<NUMRUN + IFOFF . GT . 50)NUHRUN = 50 - IFOFF 
DO 6 I=1.NUHRUN 

J = I + IFOFF 

6 URITE <LU, 202 ) I . F I LE ( 1 ) , F I LE ( 2 ) , F D I G I T ( J ) 

C 

C FIND OUT IF THESE RUNS ARE TO BE RESEARCH RUNS (INTERACTION 

C AND PLOTTING ALLOWED) OR PRODUCTION RUNS 

C 

WRITE ( LU.203) 

READ ( LUy 101 ) I 
I F( I . EQ . RCHAR ) I OPT( 2 ) = 1 
IFU0PT<2) -EQ. 0)G0 TO 7 
URITE <LU,204) 

GO TO 12 

7 URITE < LU,205) 

C 

C FOR PRODUCTION RUNS. READ IN THE TOP OF THE SURFACE LAYER 

C AND THE SIGHA OF THE WIND AZIMUTH ANGLE TO BE USED FOR ALL RUNS 

C 

URITE < LU.206) 

READ (LU.*) TOPSUR 
URITE ( LU.207) 

READ (LU.,*) SIGA 
C 
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READ IN AND WRITE OUT THE LAUNCH TINE AND DATE -- IF NOT 
ENTERED. DO HOT WRITE ANYTHING OUT 

12 WRITE <LU.208> 

READ <LUilDl> (LAUHTD( I ). 1 = 1. 10 > 

IF<LAUNTD(1) .ES. BLANKS>GO TO 17 
LTIHE = .TRUE. 

CALL CODE 

READ <LAUNTD.102) L T I H > LDA Y , LHO H . L YE A R 
WRITE (LU.209> ( L AU NTD< I >. I =1 . 1 0 > 

GO TO 21 

17 LAUNTD<4) = SDT 

READ IN THE LAUNCH VEHICLE. LET IT DEFAULT IF NOT ENTERED. 
WRITE IT BACK OUT. AND FILL THE VPAR ARRAY WITH THE 
APPROPRIATE VEHICLE PARAMETERS 

21 WRITE <LU.210) 

READ ( LU. 101 > J 
DO 24 1=^1 .5 

IF< J . EQ. IVNAH( I >)G0 TO 25 
24 CONTINUE 
I » 1 

23 I0PT<3) * I - 1 

WRITE CLU.211) ( VNAMES(J.I >.J = 1. 4) 

DO 28 J=1 . 18 
28 VPAR( J ) = VPARSC J . I ) 

DO LOOP ON THE RUN NUMBER 

DO 7,9 RUNNUM = 1 . NUHRUN 

SET UP THE FILE NAME FOR THIS RUN, GET THE CURRENT TIME. 

AND WRITE OUT THE HEADER 

F'ILE<3> = FDIGIT< RUHHUM+IFOFF ) 

ASSIGN 31 TO IRETRN 
CALL EXEC(8. GETTD > 

31 CONTINUE 

ITIME = ITIME + 100 
I = I0PT(3) + 1 

WRITE (6.212) RUNHUN. (FILE( J ). J = l. 3). ( VNAMESC J . I ). J = l. 4) 
IF(LTIME) WRITE (£.213) LTIH.LAUNTD(4).LDAY.LM0N(1).LM0N(2).LYEAR 
WRITE (£.214) ITIME. LAUNTD(4).IDAY. MONTH. lYEAR 

OPEN THE DATA FILE FOR THIS RUN 

CALL OPEN(IDCB.IERR.FILE) 

IFdERR .GE. 0)G0 TO 32 
WRITE (£.215) lERR 


A-33 



ooooooo o o o ooo ooo o o o o 


GO TO 79 


READ THE HEADINGS FROM THE DATA FIL£< SETTING UP THE 
APPROPRIATE PARAMETERS 

32 CALL READFC IDCB, lERR. IBUF. 40, LEN } 

IF<IERR .GE. 0>G0 TO 37 
34 URITE <6,2i6> lERR 
GO TO 79 

37 IFUBUFd) .HE. TE>G0 TO 32 
39 WRITE <6,217) < I B UF< I ) , I = 1 , LEN ) 

CALL READF< IDCB, lERR, IBUF, 4 0, LEN ) 

IF<IERR .LT. 0)G0 TO 34 

IF< IBUF< 1 ) . HE . RA .AND. I BU F< 1 ) . HE . FO > GO TO 39 
IOPT< 1 ) « 0 

IF<IBUF<1) .EO. F0)I0PT<1) * 1 
WRITE <6,217) < IBUF< I ), 1=1 , LEH) 

CALL READF< IDCB, lERR, IBUF, 40, LEN) 

IF<IERR -LT. 0)G0 TO 34 

WRITE <6,217) < 1BUF< I ) , 1=1 , LEN) 

READ THE SOUND ING7F0REC AST TINE 

CALL READF< IDCB, lERR, IBUF, 9 ) 

IF<IERR .LT. 0)G0 TO 34 
CALL CODE 

READ <IBUF,103) I ST I H , I SDA Y , I SH 0 N< 1 ) , I S NON< 2 ) , I SY EAR 
CHANGE TO EST OR EDT DEPENDING ON LAUNCH TINE 
ISTIN = ISTIN - 500 

IF<LAUNTD<4) . NE . 2HST)ISTIN = ISTIN + 100 
IF<ISTIN .GT. 0)G0 TO 41 
ISTIN = 2400 + ISTIN 
ISDAY = ISDAY - I 

WRITE OUT THE NEXT LINE OF THE HEADER 

41 CALL READF< IDCB, lERR, IBUF, 40, LEN ) 

IF<IERR .LT. 0)G0 TO 34 

WRITE <6,217) < IBUF< I ), 1 = 1 , LEH) 

WRITE OUT THE SOUND ING/FOREC AST TIME 

WRITE <6,218) ISTIN ,LAUHTD( 4 ) , I SDAY, I SHOH< 1 ) , ISNON< 2 ), ISYEAR 

FIND THE FIRST DATA POINT WITH AH ALTITUDE OF 10 FEET 
OR ABOVE 

44 CALL READF< IDCB, lERR, IBUF, 40, LEH ) 
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IFCIERft .LT. 0>G0 TO 34 
CALL B2Z( IBUFC !>/ J > 

IF< J .LT .ZEROO .OR. J . GT . HI HE9 >G0 TO 44 
CALL CODE 

READ (IBUFil04> I ALT( 1 >/ ID I R< 1 > ^ SPEED( 1 TEHP( 1 >/ DFTEHP( 1 
PRESSC 1 >/SURDEN 
IF<IALTU) .LT. 10)G0 TO 44 

TRY TO FIND A TOTAL OF 30 DATA POINTS WITH ALTITUDES 
BETUEEN 20 FT AND 10,000 FT INCLUSIVE 

NUN s 1 
DO 47 1*2,30 

46 CALL READFC IDCB, lERR, IBUF, 40, LEN > 

IF<IERR.LT.O .AND. I E RR . NE . - 1 2 > GO TO 34 
IF(LEN .EQ. -1 >G0 TO 48 

CALL B2Z( IBUF( 1), J) 

IF( J .LT .ZEROO .OR. J . GT . HI NE9 )G0 TO 46 
CALL CODE 

READ <IBUF,104) I AL T< I ) , I D I R< I ) , SP EE D < I ) , T EHP< I > , OP T EHP< I ) , 

PRESS( I > 

IF( I ALT< I ) . LT . 20 .OR. I A LT < I ) . G T . 1 00 0 0 ) GO TO 46 

47 HUN = I 

ZERO OUT THE REMAINING ELEMENTS OF THE ARRAYS 

48 NUMl * NUN * 1 

IFCNUMl .GT. 30>G0 TO 51' 

DO 49 I*HUNli30 
ALT< 1 > * 0.0 
IDIR< 1 > = 0 
SPEED( I ) = 0 .0 
TEMP< I ) = 0.0 
DPTEMPt I ) = 0.0 

49 PRESS( I > = 0.0 

CONVERT TO METRIC UNITS 

51 DO 52 1*1, HUM 

ALT(I) = 0.3048 * FLO AT( I ALT< I ) ) 

52 SPEEDCI) = 0.515 * SPEEO(I) 

SORT ALL THE DATA POINTS SO THEY APPEAR IN ASCENDING 
ORDER OF ALTITUDE 

NUMl = HUM - 1 
DO 58 1=1, NUMl 
JJ * HUM - I 
DO 57 J*1 , J J 
J1 * J + 1 
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1F(ALT<J) -LE. ALT(J1))G0 TO 57 
ARC - ALT< J ) 

ALT<J) = ALT<J1) 

ALT< J1 > = ARC 
lARG - IDIR(J> 

IDIR< J > = IDIR( J 1 > 

IDIR< J 1 ) = lARG 
ARG = SPEED(J> 

SPEED( J > = SPEED( J1 > 

SPEED(Jl) » ARG 
ARG = TEMP< J ) 

TEHP< J > = TE«P< J 1 ) 

TEHP< J 1 > = ARG 
ARG = DPTEMP< J ) 

DPTEMP< J ) = 0PTEMP< J1 ) 

DPTEHP( > = ARG 
ARG = PRESS< J ) 

PRESS< J } » PRESS*; J1 ) 

PRESS(Jl) = ARG 

57 CONTTHUE 

58 CONTINUE 

CALCULATE THE POTENTIAL TEMPERATURE 
DO 62 I==iiNUH 

62 PTENPd) * <TEMP<n + 273.15) • < ( 1000 . 07PRESS< I > )**0 . 288 > 

URITE THE HEADER FOR SOUNDING OR FORECAST 

IF< IOPT< 1 ) . EQ . 1 >G0 TO 64 
URITE <6.219) 

GO TO 65 

64 WRITE ( 6. 220) 

WRITE THE SURFACE DENSITY AND ALL THE DATA POINTS 

65 WRITE < 6. 221 ) SURDEN 
URITE (6.222) 

DO 68 1==1 .HUH 

lALTF = 3.281 * ALT< I ) + 0.5 
lALTM = ALT( I ) + 0.5 
APTEHP = PTEHP(I) - 273.15 

68 WRITE ( 6. 223 ) I . I ALTF , lALTH . I DI R( I ). SPEED( I ) . TEHP( I ) . 

APTEHP. DPTEHP< I ). PRESS( I ) 

TRANSFER TO THE SEGMENT CLDRI -- THE CLOUD RISE MODEL 

ASSIGN 75 TO IRETRN 
CALL EXEC(8. CLDRI > 

75 CONTINUE 
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CLOSE THE DATA FILE 
CALL CLOSE! IDCB) 

PROCESS THE NEXT RUN 
79 CONTINUE 

STOP EXECUTION 
STOP 

END OF H0D3A 

END 

SUBROUTINE DFEXP! J . COHC ) 


THIS SUBROUTINE CALCULATES DIFFUSION EXPONENTIALS 

J - INDEX IN THE ALT ARRAY OF THE TOP OF THE LAYER 
CONC - CONCENTRATION TO BE TESTED 


COHNOH BLOCK 

COnnON ALT(31),AL1.C0HNAX/C OH CPK, DEGRAD, ADIR,DOSPK/El,CLDHTi 

IDIR<31>,I0PT(3)/ITIWE/IDAY,H0NTH(2)/IYEAR,ISTIM/ISDAY, 
ISM0N(2),ISYEAR,IV2,JT0P,LAUNTD(10),LTIME,LTIH,LDAY, 
LM0N(2)iLVEAR,LU,NUH,PI,PI0VR2,PI43,PRESSC31 ).PTEI1P<31 ), 
QliRA0OEG,RAT0NC/CLORAD/R2,R3,SAVEA(30>,SAVER(30>,SIGA, 
SIGX0,SIGX,SPEE0(31),SQR2PI,SURDEN,SIGZ0,SIGAP/S8>TEHP(31), 
T0PSUR,TU0PI,ASPD,VPAR(18),CRTIHE(3l),DIST,YES,YliNUNRUN, 
YPOS , IFLGl < 5 ), ZB, ZZ, REFLEC, IRETRH 
LOGICAL LTIME 
INTEGER YES 

EQUIVALENCE < QCl , VP ARC 1 > >, ( QC2, VPAR< 2 > ) , ( Q C3 , V P AR ( 3 ) > , 

<8T1 , VPARC 4) ), < QT2, VPAR< 5 >), < QT3, VPAR< 6 ) >, 

<AA, VPAR<7>),!BB,VPAR<8>>,<CC, VPAR<9)), 

<HEATN,VPAR(lO)>,<HEATH,VPAR<ll)),tHEATA,VPAR<12)), 

<PHCL,VPAR<13)),(PC0.VPAR(14)),CPC02,VPAR<15)), 

(PAL2 03 , VPAR< 16 )),( PNO, VPARt 1 7 )), ( GAHHAX, VPAR< 18 ) ) 


CALCULATE SIGHA Z 
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SIGZ ■ DIST * SIGAP + SIGZO/1.28 
R3 ■ 2.0 • SIGZ •SIGZ 

CALCULATE THE EXPONENTIAL SUN IN THE DIFFUSION EQUATION 

TWOI « 2.0 
ZT » ALT<J> 

TEMP2 = CLDHT - ZZ 
TEHP3 = CLDHT - 2.0 ♦ ZB + ZZ 
El » EXP( - TENP2 * TEHP2/R3) + 

EXP( - TEHP3 * TENP3/R3) 

4 TEMPI » TUOI • (ZT - 2B) 

TEXPSH = El 

TEXP ■ (TEMPI - TENP2)**2/R3 
IFCTEXP .LE. 120.0)E1 -El + EXP< - TEXP) 

TEXP ■ (TEMPI + TEMP2)**2/R3 
IFCTEXP .LE. 120.0)E1 = El + £XP( - TEXP) 

TEXP « (TEMPI - TEMP3)**2/R3 
IF(TEXP .LE. 120.0)E1 = El + EXP( - TEXP) 

TEXP » (TEMPI + TENP3)**2/R3 . , 

1F(TEXP .LE. 120.0)E1 = El + EXP( - TEXP) 

1F(E1 .EQ. TEXPSM)GO TO 7 
TUOI » TUOI + 2.0 
GO TO 4 

7 El » REFLEC * El 

CALCULATE SIGMA Y 
S8 = DIST ♦ SIGAP + SIGXO 

R2 » S8RT(S8 * SB + < 0.0040589 ♦ FLOAT! ID I R< J ) - IDIRCD) * 

DIST)** 2;) 

CALCULATE CLOUD LENGTH 

TEMPI » SPEED(J) - SPEED(l) 

ALl « 0.28 • TEMPI * DIST/ASPD 
IF(TEMP1 .GE. 0.0 )G0 TO 11 
IF<PTEMP< J )-PTEMP< 1 ) .GT. 0.0)AL1 =0.0 
ALl * ABS(ALl) 

CALCULATE SIGMA X 

11 SIGX - SfiRT( (ALl/4. 3)**2 * SIGXO * SIGXO) 

IF C0NC=1000.0. DO NOT CALCULATE CROSS WIND DISTANCE BUT RETURN 
TO THE CALLING PROGRAM 

IF(C0HC .EQ. 1000 .0 )RETURN 

c i , • 

C CALCULATE CROSS UIND DISTANCE 
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c 


Y1 = - 2.0 * R2 * R2 * AL0G(i5.7496 ♦ COHC ♦ SIGX* R? ♦ 

SIGZ/( Q1 * El ) > 

VI = S8RT<AMAX1<Y1,0.0)> 

RETURN TO THE CALLING PROGRAM 
RETURN 

END OF DFEXP , / 


END 

SUBROUTINE ORG I H( IX 0 . I YO ) 


THIS SUBROUTINE GIVES THE APPROPRIATE COORO I NATES; FOR PLOTT IHG 
FOR THE COMPLEX AND MAP SELECTED \ . 


COMMON BLOCK ] > . 

COMMON ALT< 31). ALl. COHMAX/ CONCPK.DEGRAD . ADIR ,D0SPK/ El/CLOHT. 

IDIR( 31 ). IOPT( 3 >, ITIME. 1 DAY . M0NTH( 2 >. lYEAR. I STIM. ISDAY . 
ISM0H<2 ). ISYEAR. IV2. JTOP. LAUNTDC 1 0 ) . L T I M E . LT I M > LD A Y. 

LMOH< 2).LYEAR. LU.HUM.PI. PI0VR2.PI43.PRESSC 31 ).PTEMP< 31 ). 
ai .RADOEG. RATOMC. CLDRAO. R2. R3 . SA VE A< 30 ) . SAVER( 30 ) . SI GA . 
SIGX0,SIGX.SPEED<31 ) . SQR2PI . SURDEH . SI GZO . S IGAP. SB . TENP( 31 >. 
TOPSUR. THOPI . ASPO. VPAR< 18 ), CRTIME< 31 ) . DIST . YES. Y1 . NUMRUN. 
YPOS. IFLGK5 ). ZB.ZZ.REFLEC. IRETRN 
LOGICAL LTIHE 
INTEGER YES 

EQUIVALENCE ( 8C1 . VP AR< 1 ) >. ( QC2. VPAR< 2 > > . ( QC3 . VP AR( 3 ) >. 

<QT1 . VPAR< 4) >. < QT2. VPAR< 5 ) ).< QT3 . VPAR<6 ) ). 
<AA.VPAR<7)).<BB.VPAR(8)).(CC. VPAR<9)). , I 

< HEATH. VP ARC 1 0 > ) . < HE ATM. V PARC 1 1 ) ). C HE AT A . VPARC 1 2 ) ) . 
CPHCL. VPARC 13) >.C PCO. VPARC 14 > ). C PC02. VPARC 15) >. 

CPAL2 03.VPARC16 )). CP NO. VPARC 17 )).C GAMMA X. VPARC 18) > 


INPUT FORMAT STATEMENT 
100 FORMAT CI2.1XA1) 

OUTPUT FORMAT STATEMENT 

200 FORMAT C //* (fcdBEHTER COMPLEX. |t.dFS|idBEA OR £fcdFLttidB AND NAP * 
"C».g. 17 .L)! |idJ_") 
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TYPE AHD DIHEHSIOH 8TATEHEHTS 

LOGICAL NOTIST 
INTEGER SCHAR 
DIMENSION IX<8)iIY<8) 

DATA STATEMENTS 

DATA NOTIST/ .FALSE. SCHAR/iHS/ 

DATA IX/8730i4100>54i i > 4825 , 8750 , 4 lOD .5450 . 4830// 

I Y/8 800. 7 30 0.824 3. 8 050. 299 0.1700.2830.2485/ 

IS THIS THE FIRST TIME THROUGH THIS SUBROUTINE? -- 
IF HOT. IT IS NOT NECESSARY TO CALCULATE THE INDEX OF THE 
COORDINATES. I. AGAIN 

IF(N0T1ST)G0 TO 7 

THIS IS THE FIRST TIME THROUGH -- READ IN THE COMPLEX NUMBER 
AND THE DESIRED HAP. i.e. SEA OR LAND 

NOTIST => .TRUE. 

HRITE (LU.200) 

READ <LU. 100 ) I. J 

CALUCLATE I AS THE INDEX OF THE COORDINATES FOR THE COMPLEX 
AND MAP ASKED FOR -- DEFAULT IS COMPLEX 17. LAND HAP 

K = 0 

1F(J .EQ. SCHARIK = 4 
J = I - 37 

IF< J .LT .2 .OR. J . GT .4 )J = 1 
1 = J + K 

SET THE COORDINATES BASED ON THE INDEX I 

7 IXO = IX< I ) 

I YO = I Y< I ) 

RETURN TO THE CALLING PROGRAM 
RETURN 

END OF ORGIN 

END 

SUBROUTINE S YH8L< IH I D E . I HI . IS Y MB > 

IXa-IHIDE/2 
1 Y»-IHI/2 
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URITE< 12> -1 «-l/ IX/ lY 
URITEC 12/ 100 > IUIOE/0/0/ IHI/ISYHB 
100 F0RHAT<4IS/ Al/ 1H_) 

IY«-IY 

URITE(12>-1/-1/IX/IY 

RETURN 

END 

SUBROUTINE B2Z(IA.IB> 

IB > IAND< lA/ 177400B) 

IF(I6 .EQ. 020000B>IB » 030000B 
IC « IAND( IA/000377B) 

IF<IC EQ. 000040B)IC » OOOOSOB 
IB = I0R( IB/ IC > 

RETURN 

END 

PROGRAM GETTD/5 
C 


THIS SEGMENT RETURNS THE CURRENT TIME/ DAY/ MONTH/ AND YEAR 


COMMON BLOCK 


COMMON ALT<31>/AL1/C0HMAX/C0HCPK/DEGRAD/ADIR/00SPK/E1/CLDHT. 

IDIR< 31 ) / lOPK 3 ) / ITIME / IDAY / H0NTH< 2 > / I Y E AR / I S T 1 H / I SO A Y / 
ISN0N<2)/ISYEAR,IV2/JT0P/LAUHT0<10).LTIHE/LTIM/LDAY/ 
LM0H(2)/LYEAR/LU/NUM/PI/PI0VR2/PI43,PRESS(31 )/PTEMP<31 )/ 

Q1 /RADDEG/ RATOMC/ CLDRAD/ R2/ R3 / SAVEA( 30 > / SAVER( 30 ) / SIGA / 
SIGX0>SIGX/SPEED(31).SQR2PI/SUR0EH/SIGZ0,SIGAP/S8/TEHP(31)/ 
T0PSUR/TU0PI/ASPD/YPAR<18)/CRTIME(31)/0IST/YES/Y1/NUMRUN/ 
YPOS/ IFLG1(5>/ZB/Z2/REFLEC/ IRETRN 
LOGICAL LTIME 
INTEGER YES 

EQUIVALENCE < QCl / VP AR( 1 ) >/ < QC2/ VPAR< 2 ) ) / < QC3 / VPARC 3 ) )/ 

<QT1 , VPAR< 4 ) )/ < QT2/ VPAR< 5 ) )/< QT3/ VPAR<6 ) )/ 
<AA/VPAR(7))/(BB/VPAR(8)>/<CC/VPAR<9))/ 

(HEATH/ VPARC 10 > )/ (HEATM/ VPAR< 1 1 ) )/ < HEATA/ VPAR< 12) )/ 
<PHCL/VPAR(13) )/(PCO/ VPAR< 14) )/( PC02/ VPAR( 15 ) )/ 
(PAL203/VPAR<16))/(PN0/VPAR<17))/(GAHMAX/VPAR(18)) 


TYPE AND DIMENSION STATEMENTS 

INTEGER DAYH0H(12> 

DIMENSION HOHTHS( 2/ 12 ) / IT( S ) 

C 

C DATA STATEMENTS 
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DATA H0HTHS/2HJA< 1HH/2HFE< lHB<2HHA/lHR<2HAP/tHR< . 

2HHAi IHYi 2HJU. 1 HH < 2H J U . 1 H L , 2H AU / IHG. 

2HSE< 1HP.2H0C. 1 HT / 2HN0 > 1 H V < 2H DE . 1HC<^ 

DATA DAYH0H/31.28i31,30.31 ,30,31.31.30, 31 , 30, 31/* 

CALL EXEC TO RETURN CURRENT TINE, JULIAN DAY, AND YEAR 

CALL EXECdl.IT, lYEAR) 

USE JUST HOURS AND MINUTES FOR THE TINE 

ITIHE = 100 * IT<4) + IT<3) 

HAKE APPROPRIATE ADJUSTMENTS IF THIS IS A LEAP YEAR 

DAYHQH(2) 28 
I = IYEAR/4 

IF(4*I .EQ. lYEAR )DAYH0H(2 ) = 29 

CONVERT THE JULIAN DAY INTO A MONTH AND A DAY 

IDAY = IT<5) 

DO 7 1^1,12 

IDAY > IDAY - DAYMON( I > 

IFdDAY .LE. 0)G0 TO 12 
7 CONTINUE 

12 IDAY = IDAY + DAYMOH< I ) 

MONTH< 1 ) = MONTHS< 1 , I ) 

MOHTH< 2 ) = M0NTHS<2, 1 ) 

RETURN TO THE APPROPRIATE PLACE IN M0D3A 

GO TO IRETRN 
17 CALL N0D3A 

END OF GETTD 


END 

PROGRAM CLDRI,5 


CLOUD RISE PROGRAM -- A SEGMENT OF THE M0D3A PROGRAM 


COMMON BLOCK 
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COHMOH ALT<31 )i ALli COHHftX,COHCPK>DEGRAD<ADIR^DOSPK, El.CLDHT^ 

IDIR<31 >W0PT<3>, ITINE. IDAY>NOHTH( 2 > / lYEAR/ISTIN. I5DAY< 
ISnON(2 ISYEAR. IV2. JTOP,LAUHTD( 10 ),LTIHE/ LTIM/LDAY/ 

LM0H( 2)>LYEAR, LUi HUH.PI. PI0VR2,P143,PRESS( 31 >.PTEHP( 31 >« 

Q1 <RADDEG/RAT0HCiCLDRA0.R2.R3<SAVEA(30>.SAVER(30>.SIGA. 
SIGX0<SIGX.SPEE0( 31 >,SQR2PI <SURDEHi SIGZ0.S1GAP/S8^ TEHP(31 )/ 
TOPSUR. TUOPIi ASPDi VPAR( 18 CRTIHE< 31 l.DIST. YES. Y1 . HUHRUN. 
YPOS, IPLGKS ), ZB, Z2. REFLEC, IRETRH 
LOGICAL LTIHE 
INTEGER YES 

EQUIVALENCE < QC 1 , VP AR< 1 > >, ( QC 2 , VP AR( 2 > > , ( QC3 , V P AR< 3 > > , 

<QT1 , VPAR( 4 ) >, ( QT2, VPAR< S > >,( 8T3, VPAR< 8 > >, 

<AA, VPAR<7)),<BB,VPAR<8)),(CC,VPAR<9) ), 

< HEATN, VPAR< 10 ) ), < HEATN, VPAR< 1 1 ) ), < HEATA, VPAR( 12) ), 
<PHCL,VPAR<13)),(PC0,VPAR<14)),<PC02,VPAR{15)>, 

(PAL2 03 , VPAR( 16 >),(PH0, VPARU7 )).<GAHHAX, VPAR( 18) ) 


OUTPUT FORMAT STATEMENTS 

200 FORMAT < “ 1 • 2 7X “ E X H A US T C LO U D " / ■ 0 LE VE L " 4 X ■ A LT I T U DE • I 7 X 
"RISE TIME"5X"RANGE*6X"DIRECTI0N"710X"CMETERS>"17X 
"(SECONDS )"4X“< METERS )"4X"C DEGREES )• ) 

201 FORMAT < 2 X I 3 , 5 XF 7 . 1 , 5 X " A 0 1 A BA TI C " 5XF 6 . 1 , 6 X F7 . 1 , 7XF5 . 1 ) 

202 FORMAT < 2X1 3 , 5XF7 . 1 , 6X "STABLE "7XF6 . 1 , 6XF7 . 1 , 7XF5 . 1 ) 

203 FORMAT ( / / “ 0 C LO UD ST AB L I Z AT I ON / 

6X"HEIGHT(M )i "F6. 1/ 

6X*STABILIZATI0N TIME AFTER LAUNCH<SEC)i "F5.1/ 

6X"RANGE FROM PAD<M)s "F7.1/ 

SX'DIRECTION FROM PADCOEG)! “F5.1) 

204 FORMAT (/'/’■■ESTIMATED TOP OF SURFACE LAYER(M): "F6.1) 

205 FORMAT < " |tdBDES 1 RED TOP OF SURFACE LAYER(M)i |LdJ_"> 

206 FORMAT ( / / " 0 ** T OP OF SURFACE LAYER METEOROLOGICAL PARAMETERS" 

6X“HEIGHT(M ): "F6.1/ 

6X"«IND DIRECTION(DEG )t "13/ 

6X"WIND SPEED< M/’SEC )! "F4.1) 

207 FORMAT < / / " 0 ■»* ** D I F FU S 1 0 N P AR AMETERS****" / 

6X*MEAN SPEED( M/SEC ) : "F4.17 

6X"MEAN TRANSPORT D 1 R EC T 1 0 N< D EG > : "F5.1> 

208 FORMAT ( / / * £ &dBS I GM A OF UIHD AZIMUTH ANGLE, SIGA: £t.dJ-") 

209 FORMAT (/'/'"OSIGMA OF WIND AZIMUTH ANGLE. SIGA! "F4.1> 

210 FORMAT ( //" OEFFECTI VE CLOUD HEIGHT(M)! "F6.1) 

TYPE AND DIMENSION STATEMENTS 

INTEGER C0HC(3) 

DIMENSION IAS( 31 > 

C 

C DATA STATEMENT 
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c 

DATA C0NC/2HC0i2HNCi2H 
C 

C INITIALIZE SOME LOCAL VARIABLES 

C 

C CRTU1E( ) - CLOUD RISE TIME 

C IAS< ) - 0 = ADIABATIC 

C 1 = STABLE 

C ALTINC - ALTITUDE INCREMENT 

C ITERAT - ITERATION COUNTER 

C 

RNGY = 0.0 
RHGX = 0.0 
CRTIME< 1 ) = 0.0 
ALTINC = 0.0 
SAVER< 1 ) = 0.0 
SAVEA< 1 ) = 0.0 
ITERAT = 0 
C 

C WRITE OUT THE EXHAUST CLOUD HEADER 

C 

WRITE ( 6i 200 ) 

C 

C CALCULATE SOME QUANTITIES TO BE USED IN SUBSEQUENT DO LOOP 

C 

ALPHAC = 5. 12913086E-2 * <TEMP<1> + 273.15) * SURDEN * 
GAMMAX**3/( HEATH * QCl ) 

GT = 9 . 8/< TEMP< 1 ) + 273.15 ) 

C 

C DO LOOP TO, CALCULATE EXHAUST CLOUD PARAMETERS 

C 

DO 9 I =2i HUM 
C 

IRl = I - 1 
I AS< I ) = 1 

CALCULATE SLOPE OF POTENTIAL TEMPERATURE, SPEED, AND 
DIRECTION IN LAYER 

DALT = ALT< I ) - ALT< IM 1 ) 

GPTEMP = <PTEMP<I) - P TE HP ( I M 1 ) ) /D AL T 
GSPEED = <SPEED(I) - S PE ED < I M 1 ) ) /D AL T 
GDIR = FLOAT< I DI R< I ) - I D I R ( I M 1 ) )/ D A L T 

CALCULATE METEOROLOGICAL AND ENERGY FACTOR 

2 Z = ALT(I) - ALT<1) - ALTINC 

ALPHA = ALPHAC * Z**4/<AA * Z**BB + CC) 

C 

C CALCULATE POTENTIAL TEMPERATURE FACTOR 
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c 

STAB = GT * <PTEHP(I) - ALTIHC * GPTEHP - PTEHPU))/ 

<ALT<I) - ALTIHC - ALT(1> ♦ l.OE-7) 

CALCULATION FOR ADIABATIC RISE 

IF<STAB .GT. O.OOOOODGO TO 4 
CRTIHE( I > > SQRT< ALPHA > 

IAS< I ) = 0 
GO TO 6 

CALCULATION FOR STABLE CLOUD RISE 

C2 - ARGUMENT OF ARC COSINE (MUST BE LESS THAN -1> 

4 C2 = 1.0 - 0.5 * ALPHA * STAB 
IF<C2 . LT . -1 . 0)G0 TO 5 
C3 = C2/SQRT< 1.0 - C2 * C2 ) 

CRTIME< I+ITERAT) = <P10VR2 - ATAN( C3 ) )/'SQRT( ST AB ) 

IF< I TERAT . EQ . 1 )C0 TO 11 
GO TO 6 

ITERATE IN LAYER 

5 ALTIHC = ALTIHC ♦ 5.0 
ITERAT a 1 
GO TO 2 

CALCULATE RANGE AND DIRECTION 

6 OELRNG = - 0.5 * (SPEED<IH1) + SPEED(I)) * 

<CRTIHE< IMl ) - CRTII1E( I ) ) 

DELDIR = 0.00872665 * FL 0 A T< I 0 1 R< I ) + IDIR(IMl)) 

RNGY = RNGY - DELRNG • SIN(DELDIR) 

RNGX = RNGX - DELRNG * COS(DELDIR) 

AZHUTH = RADDEG « ATAN2( RNGY. RNGX > 

IF<AZHUTH .LT. 0.0)AZHUTH = AZHUTH + 360.0 
DELRNG = SQRTCRNGY * RNGY + RNGX * RNGX) 

SAVER< I ) = DELRNG 
SAVEA< I ) a AZHUTH 

WRITE OUT THE VARIABLES WITH THE APPROPRIATE FORMAT STATEMENT 
BASED OF WHETHER OR NOT CLOUD IS ADIABATIC OR STABLE 

IF< IAS< I ) . NE. 0 )G0 TO 8 

WRITE (6.201) I. ALT< I ).CRTIHE( I ).DELRHG.AZHUTH 
GO TO 9 

8 WRITE ( 6.202 ) I . ALT ( I ) . C RT I HE( I ) , DELR HG . A ZHU TH 

9 CONTINUE 
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C CALCULATE AND URITE OUT STABILIZATION HEIGHT AND TINE 

11 OELRNG = 0.5 * <SPEED<IM1) - ALTIHC * GSPEED + SPEED<I>) * 

(CRTIHEd + 1) - CRTIME(IH1>> 

DALT = 0.00872665 * ( F LO AT < I D IR( I ) + IDIR<IH1)> - GDIR * ALTIHC) 
RMGY = RNGY - DELRNG * SINCOALT) 

RNGX = RNGX - DELRNG ♦ C0S<DALT) 

AZMUTH = RAODEG * A TA N 2( RN6 Y. RNG X ) 

IF<A2MUTH .LT. 0.0)AZMUTH = AZHUTH + 360.0 
DELRNG = SQRKRNGY * RNGY + RNGX * RNGX) 

ALT( 31 ) = ALT< I ) - ALTIHC 

WRITE <6.203) AL T < 3 1 ) . CR TI ME( 1+ 1 ) . DEL RN G . A ZH UTH 

STORE THE INDEX OF THE ESTIMATED TOP OF THE SURFACE LAYER 
JTOP =1+1 

LOAD THE CLOUD RISE TIME ARRAY 

CRTIME<31) = CRTIHE<JTOP) 

DO 15 J=I >NUH 
15 CRTIMEI I ) = CRTIHE< 31 ) 

IS THIS A RESEARCH OR A PRODUCTION RUN? 

IF<I0PT<2) .NE. 0)G0 TO 22 

PRODUCTION RUN -- IF TOPSUR IS UNDEFINED. USE JTOP AS ESTIMATED 

17 IF<TOPSUR .LE. 0.0)G0 TO 24 

CALCULATE JTOP BASED ON VALUE OF TOPSUR 

LEASTD = 9999999.9 
DO 19 1=1 .HUM 

DIFF = ABS(ALT<I) - TOPSUR) 

IF<DIFF .GT. LEASTD)GO TO 19 
LEASTD = DIFF 
JTOP = I 
19 CONTINUE 
GO TO 24 

WRITE OUT THE ESTIMATED TOP OF SURFACE LAYER -- READ IN 
THE ONE TO BE USED -- CALCULATE JTOP 

22 WRITE (LU.204) ALTIJTOP) 

WRITE < LU. 205 ) 

READ (LU.*> TOPSUR 
GO TO 17 
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WRITE OUT THE TOP OF THE SURFACE LAYER AHD WIND DIRECTION 
AND SPEED AT THE TOP 

24 TOPSUR = ALTC JTOP ) 

WRITE <6,206) TO P SUR , I D I R< J TOP ) , SP EE D < J TO P ) 

CALCULATE SOURCE STRENGTH 

Q1 = 1.289E9 ♦ <TEHP<1> + Z73 . 1 5 )/PR E SS <i ) * T0PSUR**0 . 4837 

CALCULATE AND WRITE OUT THE MEAN WIND SPEED, ASPD, AND 
DIRECTION, ADI R 

DO 28 1=2, JTOP. 

IF< I ABS( IDIR< I ) - IDIRd - D) .LT. 180)G0 TO 28' 

DO 27 J=l,JTOP 

27 IF<IDIR(J) .LT. 180)IDIR(J) = IDIR<J) + 360 
GO TO 31 

28 CONTINUE 

31 ASPD = 0.0 
AD IR = 0 . 0 

DO 32 1=2, JTOP 
IMl =1-1 

DALT = ALT< I ) - ALT< I N 1 ) 

ASPD = ASPD + 0.5 * (SPEED<I) + SPEED<IM1)) * DALT, 

32 ADIR = ADIR + 0.5 ♦ F L 0 A T< I D I R< I ) + IDIR<I«1)> * DALT 

DO 34 1=1, JTOP 

34 IF<IDIR<I) .GT. 360)IDIR<I) = IDIR<I) - 360 

DALT = ALTC J TOP ) - ALTC 1 ) 

ASPD = ASPD/DALT 

ADIR = ADIR7DALT 

IFC ADIR . GT . 180 . 0)G0 TO 35 

ADIR = ADIR + 180.0 

GO TO 36 

35 ADIR = ADIR - 180 .0 

36 WRITE <6,207) ASPD, ADIR 

IS THIS A RESEARCH OR A PRODUCTION RUH? 

IFC I0PTC2 ) . EQ . 0 )G0 TO 45 . 

RESEARCH RUH -- READ IN SIGA 

WRITE CLU,208) 

READ CLU,>») SIGA 
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WRITE OUT SIGA/ THE SIGHA OF THE WIND AZIMUTH AHGLE 


C 
C 

45 WRITE < 6, 209 > SI GA 
C 

SIGAP = 0 .0087266 * SIGA 

CALCULATE THE HORIZOHTAL AND VERTICAL CLOUD DIMENSIONS/ 
i . e . S IGXO AND G3PEED 

S IGXO = 0 ,297674 * ALTC 3 t ) 

GSPEED = 0.232558 * ALT<31) 

CALCULATE AND WRITE OUT THE EFFECTIVE CLOUD HEIGHT, CLDHT 

CLDHT = ALT( 31 ) 

CLDR AD = 2.15 >* S IGXO 
IV2 = 0 

I F< CLDRAD+ALTC 31 ) . GE . A LT < J TOP ) ) I V2 = 1 
SIGZO = SIGXO 

IF<IV2 .EQ. nSIGZO = (ALTCJTOP) - ALT(31) + CLDRAD)/4.3 
IF<SIGZO .GT, 0.0 )G0 TO 47 
CLDHT = 0.5 * ALT<JTOP) 

SIGZO = 0.64 * CLDHT/2 . 15 
GO TO 49 

47 IF<IV2 .EQ. DCLDHT = 0.5 * (ALT<JTOP) + ALT(31> - CLDRADJ 
49 WRITE <6,210) CLDHT 

CALL THE SEGMENT CONC 
CALL EXEC<8,C0NC> 

END OF CLDRI 


END 

PROGRAM CONC, 5 


^ .+ 




CONCENTRATION AND DOSAGE PROGRAM -- A SEGMENT OF THE 
M0D3A PROGRAM 


* Ml Ml 


COMMON BLOCK 

COMMON ALT(31),AL1,C0NMAX/C0NCPK,DEGRAD,ADIR,D0SPK,E1,CLDHT, 

IDIR< 31 ), I OPTC 3 ), IT IME, IDAY .. MOHTH< 2 ), I YEAR , I STI M, ISDAY , 
ISM0N(2),ISYEAR,IV2,JT0P,LAUHTD<10),LTIME,LTIM/LDAY, 
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: ' LH0H<2)iLYEAR/LU.HUN.PI/PI0VR2>PI43«PRESS(31 >iPTEHP(31 >/ 

' Ql,RADOEG.RftT0HC.CLDRADiR2iR3>SAVEA(3O>,SAVER(30>.SIGft. 

SIGXOiSIGX,SPEED( 31 >/SQR2PI /SURDEN, SIGZOiSIGAP. S8, TENP< 31 >« 
TOPSUR, TWOPl . ASPD. VPAR( 18 >/ CRTIHEC 3l)iDISTi VES. Y1 > NUHRUN^ 
YPOS/ 1FLG1(S>/2B/ZZ.REFLEC/ IRETRN 
LOGICAL LTI HE 
INTEGER Yes 

EQUIVALENCE ( QCl , VP AR< 1 ) >/ C QC 2 / V P A R< 2 > > < ( Q C3 . V P AR< 3 ) > . 

<QT1 . VPAR< 4) )- ( QT2, VPAR< 5 )).< QT3- VPAR<6 ) ), 

( AA. VPAR( 7 > >.( BB< VPAR< 8) ) I < CC . VPAR< 9) 

(HEATH. VP A R( 10 >),( HEATH. VPAR( 1 1 > ). ( HEATA . VPAR< 1 2 ) > . 
(PHCL. VPAR< 1 3> ) .( PCO . VPAR< 14 > ) , ( PC02. VPAR< 15 ) ). 
(PAL203. VPAR< 16 ) ) . < PHO . VP AR< 1 7 ) ) . ( GAHHAX , VPAR< 1 8 ) ) 


INPUT FORHAT STATEHEHT 
100 FORHAT (Al) 

OUTPUT FORHAT STATEHENTS 


201 FORHAT 

202 FORHAT 

203 FORHAT 

204 FORHAT 


205 FORHAT 

206 FORHAT 


207 FORHAT 

208 FORHAT 

209 FORHAT 

210 FORHAT 


211 FORHAT 

212 FORHAT 

213 FORHAT 


(//'"ttdBCEHTERLINE COHCEHTR AT I ON PLOT DESIRED? “ 
"(IfcdFVtidBES OR | fc dF Hg «. dB 0 ) i ElcdJ_“) 

(5X-H0" ) 

(SX- YES“ ) 

< " 1" 12X“CL0UD CONCENTRATIONS AND DOSAGES"/ 
“0DISTANCE"4X”C0NCENTRATI0N"5X*D0SAGE"6X 
"TIHE AFTER L AUNCH< SEC ) " / 

■ <HETERS>*8X"(PPH)"8X"(PPH S EC ) “ 8 X " S T A R T “ 3 X " F I N I SH “ ) 
(lXF7.1.8XF7.3,8XF7.3i9XF5. 1.3XF5. 1 ) 

<//*0***t‘POIHT OF HAXIMUM CONCENTRATION****"/ 

6X"RANGE FROH PAD(H): "F8.1/ 

6X"DIRECTI0N( DEG )! "F5.1/ 

6X"HEIGHT(H )! 2.0"/ 

6X*HAXIHUH CONCENTRAT ION< PPH ) ! "F6.3) 
<//"|«.dB0FF-CENTER CONCENTRATIONS DESIRED? " 

" < |LdFV|*,dBES OR £ L dF N£ «. dB 0 ) ! |«.dJ_") 
(//"0****C0HCENTRATI0NS AND DOSAGES VITH 10 DEGREE " 
•UNCERTAINTIES****") 

< /"ILdBRANGEC H ) . AZIHUTH(DEG) “ 

■<0 RANGE TERHINATES PROCEDURE): 

< "0’5X*RANGE< H ) : “F7.1/ 

6X"AZIHUTH< DEC ): "F5.1/ 

6X"HATERI AL “5X “CONCENT RATI 0N( PPM) " 1 1 X"D0SAGE< PPM )" ) 
(415.12) 

( 7X3A2. 6XF8 . 3'^ + /- " F8 . 3 . 4X F8 . 3 " +/- "F8.3) 
(//"EidBISOPLETH PLOT DESIRED? “ 

“(tLdFYEidBES OR £ «. dF N£ «. dB 0 ) : |LdJ_") 


TYPE AND DIMENSION STATEHENTS 
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c 

LOGICAL IGRAF 

DIMENSION FACT(3 >.CMHPL(3)>DHHPL(3 >, HATS< 3iS >. ISOPO( 3) 

DATA STATEMENTS 

DATA F ACT /O.D>-0. 17 4533,0.174533/ 

DATA HATS/2H ,2HHC,2HL ,2H ,2H C,2H0 , 

2N ,2HC0,2H2 ,2H A,2HL2,2H03, 

2H ,2H H,2H0 / 

DATA ISOPO/2HIS, 2H0P, IHO/ 

IF THIS IS A RESEARCH RUN, DETERMINE IF PLOTTING IS DESIRED 

IF( I0PT<2 ) . EQ . 0 )G0 TO 55 
C 

WRITE <LU,201) 

READ < LU, 100 ) I 

IF(I .EQ. YES)GO TO 54 

IGRAF = .FALSE. 

WRITE < LU,202) 

GO TO 55 

54 IGRAF = .TRUE. 

WRITE <LU,203) 

C 

C DO LOOP FOR CONCENTRATION AND DOSAGE CALCULATIONS 

C 

C DIST - RANGE FROM STABILIZATION 

C D.OSPK - DOSAGE 

C DOSHAX - MAXIMUM DOSAGE 

C COHCPK - CONCENTRATION 

C CONMAX - MAXIMUM CONCENTRATION 

C 

55 CONMAX = 0.0 
DOSMAX = 0.0 

ACTVOL = PI43 ♦ CLDRAD ♦ CLDRAD * CLDRAD 
TOTVOL = ACTVOL 

IF<IV2 .EQ. UACTVOL = PI ♦ (ALT(JTOP) + CLDRAD - ALTC31))**2 ♦ 

<2.0 * CLDRAD - ALT(JTOP) + ALT(31))/3.0 

Q1 = Q1 I- ACTVOL/TOTVOL 
C 

WRITE <6,204) 

C 

DO 59 1=0,20000,250 
C 

DIST = I 
C 

CALL DFEXP< JTOP, 1 000 . 0 ) 

C 

DOSPK = Q1 * E1/<TW0PI ♦ R2 * ASPD * SQRKO.S * R3)) 
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CONCPK >: DOSPK • ASPD/(SQR2PI • SIGX> 

C 

IFUGRADCALL CPLOT 
C 

DOSHAX > AHAXKDOSPK^ D0SHA>O 
C 

IF<CONCPX-..LE. COHMAX)CO TO 58 
RATOMC » DIST 
CONHAX s COHCPK 
SGXNAX = SICX 
SGYHAX = SIGY 
C 

58 IF<AHOD(DIST/ 1000 .0 ) .HE. 0 ,0>G0 TO 59 
C 

ARGl = CRTIHE<31> + (DIST - AL1)/ASPD 
ARG2 = CRTIME(31> + (DIST + AL1)/ASPD 
WRITE (6,205) D I S T , CO H CP K , D OS PK , AR G 1 , AR G2 
C 

59 CONTINUE 

CALCULATE AND WRITE OUT THE POINT OF MAXIHUH CONCENTRATION 


C 


C 


C 


C 


C 


ARGl e DEGRAD * ADIR 
DIST = RATOHC * C08( ARGl ) 

VI = RATOMC * SIH( ARGl ) 

DO 62 I=2.JT0P 

IF(CLDHT .LE. ALT(I))GO TO 63 

62 CONTINUE 
I = JTOP 

63 I Ml = I - 1 

RANGSR = SAVER(IMl) + (CLOHT - ALT(IMl)) ♦ 

(SAVER(I) - SAVER( IMl ) )/< ALT( I ) - ALT(IMl)) 

ARGl = SAVEA(I) - SAVEA(IMl) 

IF(ABS(ARG1) .LT. 180.0)G0 TO 66 
IF(ARG1 .’GT. 0.0)G0 TO 65 
SAVEA(I) = SAVEA(I) + 360.0 
GO TO 66 

65 SAVEA(IMl) = SAVEA(IHl) + 360.0 

66 AZCS = SAVEA(IMl) + (CLDHT - ALT(IMl)) * (SAVEA(I) - SAVEA(IMl))/ 

( ALT( I ) - ALT( IH 1 ) ) 

IF(AZCS . GE . 360.0)AZCS = AZCS - 360.0 

ARGl DEGRAD * AZCS 
X2 = RANGSR * COS( ARG 1 ) 

Y2 = RANGSR * SIH( ARGl > 

X = DIST + X2 
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y = Y1 + Y2 

c 

RNGE = SQRT<X * X + Y * Y) 

DIR RADDEG * ATAN2(Y,X> 

IFtDIR .LT. 0.0)DIR = DIR + 360.0 
WRITE ( 6/ 206 > RN G E / D 1 R . C OH t1 AX 

IF THIS IS A PRODUCTION RUN< SKIP THE OFF CENTER CONCENTATION 
SECTION AND THE CALL OF SEGHENT ISOPO -- IF PLOTTING HAS HOT 
REQUESTED. JUST SKIP THE OFF CENTER CONCENTRATION SECTION 

IF(IGRAF)GO TO 68 
IF( I0PT<2 ) . EQ . 0 )G0 TO 88 
GO TO 81 

OFF CENTER CONCENTRATIONS SECTION 
68 CALL LABELIJTOP) 

ARE OFF CENTER CONCENTRATIONS DESIRED? 

WRITE < LU. 207 ) 

READ < LU. 100 ) I 
IF<I .NE. YESJGO TO 78 

OFF CENTER CONCENTRATIONS ARE DESIRED 

WRITE (LU.203) 

WRITE < 6, 208 ) 

C 

CALL ORGI N< I XSET . lYSET ) 

C 

ARGl = 0.0 

IF<ADIR .GT. 180.0)ARG1 = 360.0 
BETAF = DEGRAD * (180,0 + ARGl - ADIR) 

C 

ARGl B 0.0 

IF(AZCS .GT. 180.0)ARG1 = 360.0 
BETAS = DEGRAD ♦ (180.0 + ARGl - AZCS) 

XP = RANGSR * COS(BETAS) 

VP = RANGSR * SIH(BETAS) 

C 

ITER = 0 
C 

C LOOP OH OFF CENTER CONCENTRATION REQUESTS 

C 

71 ITER = ITER + 1 
C 

C READ IN AND WRITE OUT THE RANGE AND AZIMUTH FOR THE 

C OFF CENTER CONCENTRATION CALCULATION -- ENTERING A RANGE OF 0 
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C 

C 


TERMIHATES THE PROCEDURE 


WRITE <LU,209) 

READ <UJ,*> RP,AZP 
IF<RP . LE . 0 .0 >G0 TO 81 
WRITE (8.210) RP.AZP 

ARGl =« 0.0 

IF(AZP .GT. 180.0)ARG1 = 360.0 
AP = DEGRAO * <180.0 + ARGl - AZP) 

XS = ,RP * C0S< AP ) 

YS = R'P * S INC AP ) 

ON THE PLOTTER. WRITE OUT AH ASTERISK AND THE ITERATION 
HUMBER AT THE LOCATION WHERE THE OFF CENTER CONCENTRATION 
CALCULATION IS DESIRED 

IX = IXSET + 0.2631 * XS 
lY = lYSET + 0.3545 * YS 
WRITE (12) -l.l.IX.IY 
CALL SYMBLC 1 00 . 1 25. IH* ) 

IX = IX + 75 

WRITE < 12 ) -1.1. IX. lY 

WRITE (12.211) 100.0.0,125. ITER 

CALCULATE THE CONCENTRATIONS AND DOSAGES AT THIS POINT PLUS 
10 DEGREES UNCERTAINTIES ON EITHER SIDE 

XHAT * XS - XP 
YHAT = YS - YP 

DO 74 1=1.3 

ARGl = BETAF - FACTC I ) 

Y = - XHAT * SIN(ARGl) + YHAT ♦ COS(ARGl) 

CALL DFEXPC JTOP. 1 000. 0 ) 

DOS = Q1 * El * EXP(- Y * Y/(2.0 * R2 * R2))/ 

(THOPI * R2 ♦ ASPD * SQRTC0.5 * R3)) 

CONC = DOS * ASPD/(SQR2PI * SIGX) 

CMNPLC I ) = CONC 
74 DMHPLC I ) = DOS 

CALCULATE AND WRITE OUT THE CONCENTRATION AND DOSAGE FOR 
EACH MATERIAL 

DELC = ABSC0.5 * <2,0 * CMNPL(l) - CMNPL(2> - CMHPL(3))) 

DELD = ABSCO.S * (2.0 ♦ DHNPLC 1 ) - DMNPL(2) - DMNPLC3))) 

WRITE (6.212) <MATS< I / I ). 1 = 1. 3 ). CMNPLC 1 ). DELC. DMNPLC 1 ). DELD 

ARGl = PC07PHCL 

CONC = ARGl * CMNPLC 1 ) 
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DLC = ARGl * DELC 
DOS = ARGl ♦ DMHPL< 1 ) 

OLD = ARGl * DELD 

WRITE <6.212) <«ATS< 1 . 2). 1 = 1, 3 > . CONC . DLC. DOS .OLD 

ARGl = PC02/PHCL 
CONC = ARGl * CHNPLCl) 

DLC = ARGl * OELC 
DOS = ARGl * DMHPL< 1 ) 

OLD = ARGl * OELO 

WRITE <6.212) <MATS< I . 3). 1=1. 3), CONC, DLC. DOS.DLD 

ARGl = PAL203/PHCL * 0.43882420 ♦ PRESS<1)/ 

< TEMP< 1 ) + 273.1 6 ) 

CONC = ARGl * CMNPL< 1 ) 

DLC = ARGl * DELC 
DOS = ARGl ♦ DMNPL< 1 ) 

DLD = ARGl * DELD 

WRITE <6.212) < MATS< I , 4) . 1=1. 3 ) . CONC . DLC. DOS . DLD 

ARGl = PHO/PHCL 

CONC = ARGl * CMNPL< 1 ) 

DLC = ARGl * DELC 
DOS = ARGl * DMHPL< 1 ) 

DLD = ARGl * DELD 

WRITE <6.212) <MATS<I.5).I=1,3).C0NC.DLC.D0S.DLD 

REQUEST ANOTHER POINT FOR AN OFF CENTER CONCENTRATION 
CALCULATION 

GO TO 71 

OFF CENTER CO N CE NT R A I OH S ARE NOT DESIRED 

78 WRITE < LU,202 ) 

IS AN ISOPLETH PLOT DESIRED? 

81 WRITE <LU.213) 

READ < LU. 100 ) I 

IF AN ISOPLETH PLOT IS DESIRED. CALL THE SEGMENT ISOPO 

IF<I .NE. YES)GO TO 87 
WRITE <LU.203) 

CALL EXEC<8. ISOPO ) 

87 WRITE <LU,202) 

RETURN TO THE APPROPRIATE PLACE IN M0D3A 
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88 GO TO IRETRH 

89 CALL H0D3A 

END OF COHC 


END 

SUBROUTINE CPLOT 


THIS SUBROUTINE PLOTS T H E CO H CENT R AT I ON AND DOSAGE CENTERLINE 


COHHON BLOCK 

COHN OH ALT(31),AL1/C0HHAX.C0NCPK^DEGRAD.ADIR>D0SPK^E1.CLDHT> 

IDIR<31),I0PT(3>,ITIME,IDAY,H0NTH<2>,IYEAR,ISTIM,ISDAY, 

ISM0N<2),ISYEAR,IV2.JT0P.LAUHTD<10),LTIME.LTIM.LDAY. 

LMOH<2),LYEAR,LU,NUM,PI>PI0VR2,PI43,PRESS(31),PTEMP(31), 

01 . RADDEG, RATONC. CLDRAD. R2. R3 , SAVEA< 30 ) . SAVER(30) , SI GA , 

SI GXO ,SIGX .SPEEDC 31 > > SQR2PI .SURDEN, SIGZO , S ICAP. S8 , TENP< 31 >. 
T0PSUR.T«0PI,ASPD.VPAR(18).CRTINE(31),DIST.YES.Y1,NUHRUN, 
YPOS, IFLGK3 ). ZB, ZZ, REFLEC. IRETRH 
LOGICAL LTIHE 
INTEGER YES 

EQUIVALENCE <QC1,VPAR< 1>>,<QC2,VPAR<2)),(QC3,VPAR(3)>, 
<QT1.VPAR<4)),(QT2,VPAR<5)),<QT3,VPAR(6)), 
<AA,VPAR<7)>,<BB,VPAR<8)),<CC,VPAR(9>), 
<HEATH,VPAR<10)>,<HEATH,VPAR<11)),<HEATA,VPAR<12)), 
<PHCL,VPAR(13)),(PC0,VPAR<14)),(PC02,VPAR(15)), 

<PAL203 , VPAR< 1 &) ) , < PNO, VPAR< 1 7 > ), < GAHHAX , VPAR< 1 8 ) ) 


IEXPC=0 

IEXPDsIEXPC+2 

IX=DIST*9295 ./300 00 .*725 . 

I YC = C0HCPK*823l . /lO .**< IEXPC+1 ) + 1040 . 
I YD*D0SPK*8231 . / 1 0 . *♦ < I E XP D + 1 >+ 1 04 0 . 
IF<DIST.NE.O. > GO TO 30 
URITE( 12> -1 ,1 , IX, I YD 
CALL SYNBL< 100,100,254008) 

HRITE( 12) -i,l,IX,IYC 

RETURN TO THE CALLING PROGRAH 


RETURN 
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30 


«RITE( 12) 1 , 1, IX, lYC 
URITE< 12) -1,1,IX,IY0 
CALL SYMBL< 100, 100, 25400B) 

«R ITE< 1 2) - 1 , 1 , IX , I YC 

RETURN TO THE CALLING PROGRAH 

RETURN 

END OF CPLOT 


END 

SUBROUTINE LABEL<J2) 


THIS SUBROUTINE LABELS THE CONCENTRATION AND DOSAGE CENTERLINE 
PLOTS 


COMMON BLOCK 

COMMON ALT< 31 ) , AL 1 , CONMAX, CONCPK , DEGRAD , AO IR , DOSPK, E 1 , CLDHT , 

IDIR<31),I0PT<3),ITIME,IDAY,M0NTH(2),IYEAR,ISTIM,ISDAY, 

ISM0N<2),ISYEAR,IV2,JT0P,LAUNTD(10),LTIME,LTIM,LDAY, 

LMONC 2 ) , LYEAR, LU, HUM ,P I, P I0VR2 , P 14 3, PRESSC 31 ) , PTEMP( 31 ) , 
Q1/RADDEC,RAT0MC,CLDRAD,R2,R3,SAVEA(30),SAVER(30),SIGA, 
SIGX0,SIGX,SPEED(31),SQR2PI,SURDEH,SIGZ0,SIGAP,S8,TEMP(31), 
tOPSUR, TU0PI,ASPD,VPARfl8),CRTIME(3l),DIST,YES,Yl,NUMRUN, 
YP0S,IFLG1<5),2B,ZZ,REFLEC,IRETRH 
LOGICAL LTIME 
INTEGER YES 

EQUIVALENCE <QC1,VPAR(1)>,(QC2,VPAR(2>),(QC3,VPAR(3)), 
<QT1,VPAR(4)),<QT2,VPAR<5)),(QT3,VPAR(6)), 
<AA,VPAR(7)),<BB,VPAR<8)),(CC,VPAR(9)), 
<HEATN,VPAR<lO)),<HEATM,VPAR(ll)),(HEATA,VPARC12)), 
<PHCL,VPAR<13)),(PC0,VPAR<14)>,(PC02,VPAR(15)>, 
CPAL203,VPAR(:i6)),(PN0,VPAR<17>),<GAMMAX,VPAR<18)> 


OUTPUT FORMAT STATEMENTS 

200 FORMAT (415,12) 

201 FORMAT (4I5,F5.0) 

202 FORMAT <415, F5, 2) 

203 FORMAT <415, 14" E " A 2 , 2 X I 2 , 1 XA 2 , A 1 , 1 X I 4 ) 
C 

C LABEL THE PLOT 
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IEXPC=0 
IEXPD=IEXPC+2 
HEXPC=- lEXPC 
MEXPD*-IEXPO 

WRITE < 12 ) -1.1. 300 .5000 

WRITE <12.200) 0. 150. -100. 0 .HEXPC 

WRITE < 12) -1. 1.300.6500 

WRITE <12.200) 0. 150. -100, 0 .NEXPD 

WRITE < 12 ) -1.1. 3700.8950 

WRITE <12.201) 125. 0. 0. 125. CLOHT 

WRITE < 12 ) -1.1.3700. 8745 

WRITE < 12.201 ) 125. 0. 0 , 125 . CRTIt1E< 31 ) 

WRITE < 12 ) -1.1. 3700.8540 

WRITE <12.202) 1 25. 0. 0 . 1 25 . CONMftX 

WRITE < 12 ) -1.1. 3700.8335 

WRITE <12.201) 1 25. 0. 0 . 1 25 . ALT< J2) 

WRITE < 12 ) -1.1. 3700. 8130 
WRITE <12.201) 125.0.0.125.0, 

WRITE < 12 ) -1.1.3700. 7925 
WRITE <12.201) 125.0.0.125.0,0 
IF< I0PT< 1 ) . EQ , 1 )G0 TO 4 

WRITE < 12 ) -1.1. 5625. 8980 
WRITE < 12 ) 1.1 .6125.8980 
GO TO 7 

4 WRITE <12) -1.1. 5025.8980 
WRITE < 12 ) 1.1.5525.8980 
WRITE < 12 ) - 1 . 1 . 5725. 8950 

WRITE < 12.203 ) 1 2 5 . 0 . 0 , 1 25 , I S T I H . L AU N TO < 4 ) , I SD ft Y - I S 11 ON . I S YE AR 
7 WRITE <12) -1.1.5725.8695 

WRITE < 12.203 ) 1 25. 0. 0, 1 25 . I T 1 11 E . L AU N TO < 4 ) . I D A Y . t1 OH T H . I YEAR 
WRITE < 12 ) -1.1. 5725.8490 

IF<LTIME)WRITE < 12. 203 ) 125.0.0. 125. LTI11.LAUNTD(4).LDAY.L110N.LYEftR 
RETURN TO CONC 
RETURN 

END OF LABEL 


END 

PROGRAM IS0P0.5 


ISOPLETH PLOTTING PROGRAM -- ft SEGMENT OF THE M0D3A PROGRAM 
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c 

c 


COMMON BLOCK 


COMMON ALT< 3 1 ) . AL 1 . COHMAX, CONCPK . DEGR AD . ftO IR . DOSPK. El - CLDHT , 

IDIR(31).I0PT<3),ITIt1E,IDAY,M0HTH<2),IYEAR.ISTIM,ISDAV, 
ISM0N<2>.ISYEAR,IV2.JT0P.LAUHTD(10),LTIME.LTIM.LDAY, 
LH0N<2).LYEAR,LU,NUM.PI. PI0VR2.PI4 3iPRESS< 31 ),PTEMP< 31 ), 
Q1/RADOEG-RATOMC>CLDRAD.R2,R3,SAVEA<30),SAVER<30),S1GA, 
S1GX0.SIGX.SPEED<31>,SQR2PI,SURDEH,SIGZ0,SIGAP,S8.TEMP(31), 
T0PSUR.TU0PI/ASPD.VPAR(18),CRTIME(31).DIST.YES.Y1.NUMRUN. 
YPOS , IFLG H5 )> ZB, 2Z, REFLEC, IRETRN 
LOGICAL LTIME 
INTEGER YES 

EQUIVALENCE <QC1,VPAR<1)),<QC2,VPAR(2)),(QC3,VPAR(3)), 
<QT1,VPAR<4)),(QT2,VPAR(5>),(QT3,VPAR<6)), 
<AA,VPAR<7)),<BB,VPARC8)),(CC,VPAR(9)), 
<HEATN,VPAR<10)),<HEATn/VPAR(ll)),<HEATA.VPAR(12)), 
(PHCL,VPAR<13)>,(PC0,VPAR(14)>,(PC02,VPAR(15>), 

< P AL203 , VPAR< 1 6 )), ( PNO, VPAR< 1 7 ) ), ( GAMMAX , VPAR< 18> ) 


INPUT FORMAT STATEMENT 
100 FORMAT <A1) 

OUTPUT FORMAT STATEMENTS 


200 FORMAT 


201 FORMAT 

202 FORMAT 

203 FORMAT 

204 FORMAT 

205 FORMAT 

206 FORMAT 

207 FORMAT 


("1"20X"CL0UD LOCATION AND DIMENSIONS"/ 

“ TIME FROM CLOUD S T A B I L I Z A T I ON " 5 X " R AN G E " 5X " AZ I M U TH “ 
8X"0IAMETERS (METERS)"/ 

11X"<MINUTES)"14X"(METERS>"4X’(0EG)“6X"CR0SS WIND" 
4X"AL0NG WIND" ) 

(12XF6.2, 16XF8. 1,4XF5.1,7XF7. 1/7XF7.1 ) 

<//”E«.dBDEFAULT ISOPLETH CONCENTRA T ION VALUES? " 

" < tidFY^tdBES OR |idFH|«,dBO ) '• t«.dJ_") 
<//“|*.dBISOPLETH CONCENTRATION VALUE " 

"(NEGATIVE VALUE TERMINATES PROCEDURE)! tfcdJ_“) 
(415,14" E"A2,2XI2, 1XA2, Al. IXI4) 

( 4 15 , A1 ) 

(4 15, F5 ,2"_" ) 

(415", "F5.2"_") 


TYPE AND DIMENSION STATEMENTS 


LOGICAL DFALTC 
DIMENSION CONC( 1 0 ) 

DETERMINE THE ORIGIN OH THE MAP FOR THIS PLOT AND MOVE THE 
PEN THERE 

CALL ORGIN< IXO, I YO) 
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VRITE ( 12 > >1, IXO, lYO 

OETERHIHE THE INDEX IN THE ALTITUDE DATA ARRAY THAT HAS 

THAT ALTITUDE JUST LOHER THAN THE EFFECTIVE CLOUD HEIGHT. CLDHT 

DO 4 I-2.JT0P 

IFCCLDHT .GT. ALT(I))G0 TO 4 
ICLDHT « I - 1 
CO TO 5 

4 CONTINUE 
ICLDHT - JTOP 

DRAH THE LINE DEPICTING CLOUD HOVEHENT ALONG THE GROUND 
AS FAR AS THE CLOUD STABILIZATION POINT 

5 X - 0. 0 
Y - 0.0 

DO 9 I>2. ICLDHT 
IHl = I - 1 

RANGE = 0.5 * (CRTIHE(I) - CRTIHEIIMl)) • <SPEED(I) + SPEED(IHl)) 
DIR » 0.5 • FLOAT< IDIR( I > + IDIR<IH1>) 

IF< lABSC IDIR< I > - IDIRUHl)) .GT. 180>DIR = DIR - 180.0 
IFtDIR .LT. 0.0)DIR = DIR + 360.0 
DIR « DEGRAD « (360.0 - DIR) 

X X RANGE * COS(DIR) 
f = i * RANGE * SIN(DIR) 

IX = IHT( 0. 2631 • X ) + IXO 
lY = INT( 0. 3545 ♦ Y ) + I YO 

IFdX.LT.O .OR. IX. GT. 9999 .OR. lY.LT.O .OR. I Y . GT . 9999 )G0 TO 11 
9 HR ITE ( 12 ) 1 , 1 . IX . 1 Y 

HAKE THE CALCULATIONS NECESSARY TO HRITE OUT THE CLOUD 
LOCATION AND DIHENSIONS 

11 ALTl * 0.5 * (CLDHT + ALT(ICLDHT)) 

ICLDPl = ICLDHT + 1 

ARGl = ALT(ICLDPl) - ALT(ICLDHT) 

ARG2 = (CLDHT - ALT( I CLDHT ) )/ ARG 1 

SPCENT = SPEED( ICLDHT ) + ( S PE ED ( I C LD P 1 ) - SPEED( I CLDHT ) ) ♦ ARG2 
RANGE 3 SPCENT * ( C RT I HE( I C LD P 1 ) - C R T I HE ( I C LD H T ) ) * ARG2 
IF( IABS( IDIR( ICLDPl ) - I D I R ( I CL D HT ) ) .LT. 180)G0 TO 14 
IF( IDIR( ICLDPl ) .LT. 1 80 >I D IR( I CLDHT ) = IDIR(ICLDHT) + 360 
IF( IDIR( ICLDHT ) . LT . 1 80 >I D IR( I CLDHT ) = IDIR(ICLDHT) + 360 
14 DIR = FLOAT( IDIR( ICLDHT > > + (ALTl - ALT(ICLDHT)) * 

FLOAT( IDIR( ICLDPl ) - I DI R( I CLDHT > )/ARGl 
IF(DIR .GT. 360.0)D1R = DIR - 360.0 
IF(DIR .GT. 180.0)G0 TO 17 
DIR » DIR + 180.0 
GO TO 18 

17 DIR > DIR - 180.0 
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18 OIR > 180.0 > DIR 
ARGl « OEGRAD * DIR 
X « X ♦ RAHGE * C0S<0RG1> 

;>y a Y * RAHGE • SIHCARGl) 

R » SQRTC X * X ♦ Y * Y ) 

DELR » 300.0 ♦ ASPD 
C 

DACRS a 4.30 * SIGXO 
DALHG a 4.30 * SIGXO 
C 

ARGl a 180.0 

IFCDIR .GT. 180.0>ARG1 » S40.0 
AZ a ARGl - DIR 
C 

ARGl = 180.0 

IFCADIR .GT. 180.0)ARG1 = 540.0 
DAZ a ARGl - adIR 
ARGl a DEGRAD * DAZ 
DELX a dELR * COS( ARGl > 

DELY a DELR * SIN<ARG1 > 

C 

DELU a ABS< SPEED( ICLDHT) - SPEED<1>> 

C 

DELTH a IDIR(JTOP) - IDIR(l) 

C 

TIM a 0.0 
R1 a 0.0 
XC a X 
YC a Y 

TXL a 0.28 * DELU/ASPD 
SIGX02 a SIGXO * SIGXO 
S82 a S8 * S8 
WRITE ( 200 > 

C 

DO 22 ial,13 

WRITE <6.201) TIM. R.AZ. DACRS. DALHG 
TIM a TIM + 5.0 
R1 a Ri + DELR 

XL a R1 * TXL 

SIGX a SQRT< <XL/4 .30)#*2 + SIGX02) 

DACRS a 4.30 * SIGX 

SIGY a SQRT(S82 + <0.0040589 - 3.0 * DELTH • Rl)**2> 
DALHG a 4.30 • SIGY 
XC a XC + DELX 

YC a YC + DELY 

R a SflRKXC » XC + YC * YC) 

22 AZ a 180.0 - RADDEG * ATAN2<YC.XC) 

LABEL THE CLOUD STABI LI Z AT lOH POINT WITH A * 
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IX = IHT<0.2631 • X) + IXO 
lY = IHT(0.3545 • Y> + lYO 

IF<IX.LT.O .OR. IX. GT. 9999 .OR. lY.LT.O .OR. I Y . GT . 9999 )G0 TO 77 
IXX » IX 
lYY = lY 

VRITE ( 12> 1/l.IX.IY 
CALL SYHBU 150, 150, 1H+ ) 

LABEL THE POINT OF HAXIHUH COHCEHTRATI OH WITH ft 9 

DIR = OEGRftD * <180.0 - AOIR) 

CDIR - C0S<DIR> 

SDIR = SIH<DIR> 

IXl = INT<0.2631 ♦ <X + RATOHC * CDIR>) + IXO 

lYl = INT<0.3545 * <Y + RATOHC ♦ SDIR)) + lYO 

WRITE (12) -1,1, 1X1 ,IY1 
CALL SYMBL( 150,150, 1H0) 

DRAW THE LINE OF CLOUD HOVEHENT ALONG JHE GROUND FROM 
THE CLOUD STABILIZATION POINT ON 

WRITE < 12) -1, 1, IXX.IYY 
RANGE = 1000.0 
27 X - X + RANGE * CDIR 

Y = Y + RANGE * SDIR 

IX = INT< 0.2631 * X ) + IXO 
I Y = INT( 0 . 3545 * Y ) + I VO 

IFCIX.LT.O .OR. IX. GT. 9999 .OR. lY.LT.O .OR. I Y . GT . 9999 )G0 TO 29 
WRITE ( 12 ) 1 , 1 , I X , I Y 
GO TO 27 

29 WRITE < 12 ) -1, 1, IXX, I YY 

ARE DEFAULT CONCENTRATION VALUES GOING TO BE USED 
FOR THE PLOTS 

WRITE (LU,202) 

READ (LU,100) I 
DFALTC = .FALSE. 

IF(I .HE. YES)GO TO 35 

YES -- SET UP THE DEFAULT VALUES 

DFALTC = .TRUE. 

CONC( 1 ) = 0 . 1 * CONHAX 
C0NC(2) = 0.5 * CONHAX 
C0NC<3) = 0.75 * CONHAX 
CONC( 4 ) = - 1 . 0 

DO LOOP OVER THE 10 POSSIBLE CO NC E NT Rft T 1 0 N V AL UE S FOR THE PLOTS 


ft -61 
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35 DO 58 I=l<10 


IF DEFAULT CONCEHTR AT lOH VALUES ARE HOT BEING USED. 

READ IN THE VALUE FOR THIS PLOT 

IFCDFALTOGO TO 37 
WRITE (LU/203) 

READ ( LU, *) C0NC( I > 

37 IF<C0HC<I) .LT. 0.0)G0 TO 61 

ITERATE TO FIND THE LOCATION OF THIS CONCENTRATION 
ON THE PLOT 

DIST = 0.0 
DIHC s 1000.0 

41 CALL DFEXP< JTOP. CONC< I )) 

IF< Y1 . GT . 0 .0 )G0 TO 42 
DIST = DIST + DIHC 
GO TO 41 

42 IFCDINC .LE. 100.0)00 TO 43 
DIST = DIST - 900.0 
DIHC = 100.0 
GO TO 41 

43 IFCDINC .LE. 10.0)GO TO 44 
DIST = DIST - 90.0 
DIHC = 10.0 
GO TO 41 

PLOT OUT THE CONCENTRATION LINE ON BOTH SIDES 

44 DIST = DIST - 10.0 

IXI = INTC0.2631 * DIST * CDIR) + IXX 

lYl = INT<0.3545 ♦ DIST * SDIR) + lYY 

IFCIX1.lt. 0 .OR. 1X1. GT. 9999 -OR. lYl.LT.O .OR. IV1.GT.9999) 

GO TO 58 

WRITE C 12 ) -1. 1. 1X1 . I Y1 
C 

DIST = DIST + 10.0 

IX = INTC0.2631 * (DIST * CDIR - Y1 * SDIR>) + IXX 

lY = IMTC0.3545 ♦ CDIST * SDIR + Y1 * CDIR)) + lYY 

IFCIX.lt. 0 .OR. IX. GT. 9999 .OR. lY.LT.O .OR. I Y . G T . 9 99 9 ) G 0 TO 58 
WRITE C 12 ) 1 , 1 , IX . I Y 
C 

WRITE C 12 ) -1, 1, 1X1 , I Y1 
C 

1X2 = INTC0.2631 *CDIST ♦ CDIR + Y1 ♦ SDIR)) + IXX 
IY2 = INTC0.3545 * CDIST * SDIR - Y1 ♦ CDIR)) + lYY 
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IF<IX2.LT.O .OR. 1X2. GT. 9999 .OR. IY2.LT.0 .OR. IY2.GT.9999) 

GO TO 58 

C ' 

46 URITE < 12 ) 1 i 1 ,1X2, IY2 
URITE ( 12) -1,1, IX, lY 
C 

IXl = 1X2 
lYl = IY2 

DIST = DIST + 500.0 ' . ’ < ' 

CftLL DFEXP< JT0P,C0HC( I )) 

IX = IHT<0.2631 * (DIST ♦ CDIR - Y'l * SDIR>> + IKX 
lY = INT(0.3545 ♦ (DIST * SDIR + Y1 * CDIR)) + lYY 
IFdX.LT.O .OR. IX. GT. 9999 .OR. lY.LT.O .OR. I Y . GT . 9999)G0 TO 58 


WRITE 

( 12) 

1,1,IX,IY 

■ 

IF( Y1 

.GT. 

0.0)GO TO 54 


WRITE 

( 12) 

1,1,IX2,IY2 


GO TO 

58 



WRITE 

( 12) 

-1. 1, 1X1 , lYl 

• 


1X2 = INT(0.2631 * (DIST * CDIR + Y1 * SDIR)) + IXX 
IY2 = INT(0.3545 * (DIST * SDIR - Y1 * CDIR)) + lYY 
IF(IX2.LT.0 .OR. 1X2. GT. 9999 .OR. IY2.LT.0 . OR . I Y2 . GT . 9999 ) 

' ' GO TO 58 

GO TO 46 ‘ 

C 

58 COHTIHUE ^ 

ON THE PLOT, CROSS OUT EITHER THE UORD FORECAST OR SOUNDING 

61 IFdOPT(l) .NE. 0)GO TO 62 

URITE ( 12 ) -1, 1, 707,604- •' ' ' > : ■ , 

WRITE ( 12) 1,1,1174,604 
GO TO 64 , ‘ 

' t ■ ■ 

62 WRITE ( 12 ) -1, 1, 1269,'604 ' ^ 

URITE (12) 1,1,1760,604 ‘ ^ 

PRINT OUT THE PREDICTION TINE OH THE PLOT 

64 WRITE (12) -1,1,1869,319 

WRITE ( 12,204) 1 0 0, 0 , 0 , 1 50 , I T I HE , L AU N TD ( 4 ) , I D A Y , H ON TH , I YE AR 

IF THE LAUNCH TINE MAS ENTERED, PRINT IT OUT ON THE PLOT 

IF( .NOT. LTIME)GO TO 67 
WRITE ( 12) -1,1,1869,112 

WRITE (12,204) 1 0 0, 0 , 0 . 1 50 , LT I H , LAUH T D( 4 ) , LD A Y , LM ON , LY EAR 
C OH THE PLOT, PRINT OUT THE CHARACTERS + AND 0 FOR THE LEGEND 
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c 

67 «RITE <12> -1.1,1041,1342 

WRITE <12,205) 1 5 0 , 0 , 0 , 1 50 . 1H+ 

WRITE < 12 ) -1, 1, 1041, 1 104 
WRITE ( 12,205) 1 5 0, 0, 0 , 1 50 , 1 H 0 

FOR THE LEGEND ON THE PLOT, PRINT OUT THE C 0 NC EH T Rft TI 0 N VALUES 
FOR WHICH CONTOURS WERE DRAWN 

WRITE ( 12 ) -1,1, 1066,9587 
DO 75 1=1,10 

IF<C0NC<I) .LT. 0.0)G0 TO 77 
IF( I .HE. 1 )G0 TO 72 
WRITE < 12,206) 1 25 , 0 , 0 , 1 50 , COHC < I ) 

GO TO 75 

72 WRITE ( 12,207) 1 25, 0, 0 , 1 50 , COHC ( I ) 

75 CONTINUE 

RETURN TO THE APPROPRIATE PLACE IN M0D3A 

77 GO TO IRETRN 

78 CALL H0D3A 

END OF ISOPO 


END 

ENDi 
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FTN4, L 


PROGRAM REED 


C 


NASA/MSFC MULTILAYER DIFFUSION MODEL -- 21 JUN 197? 
MAIN PROGRAM -- REED 


COMMON BLOCK 

COMMON ALT< 31 )i ALl. C0HMAX> CONCPK. DEGRAD> ADIR, DOSPK, El. CLDHT , 

1DIR< 31 ). IOPT< 3 ), ITIME. IDAY . MONTHC 2 ). lYEAR. ISTIM. ISOAY . 
ISM0H<2). ISYEAR. IV2. JTOP. JBOT. LAUHTDC 10),LTIME.LTIM.LDAY. 
LMON< 2),LYEAR. LU. NUM.PI. PIOVR2.PI43 .PRESS! 31 >,PTEMP( 31 >. 
SIGHCL. RAODEG. RATOMC .CLDRAD.R2.R3. SAVEA! 30 >. SAVER! 30 ). S IGA. 
S I GXO. SIGN. SPEED! 31 ) . S OR 2P I . S URDEN . S I GZ 0 . S I G A P . SB , TE IIP ! 31 ). 
TOPSUR. TUOPI . ASPD. VPAR! 18 ). CR T I M E! 3 1 ) . D I ST , Y E S . Y 1 . NU MR U N . 
YPOS. IFLAG!5).ZB.22.REFLEC. IRETRN 
LOGICAL LTIME 
INTEGER YES 

E6U I VALENCE ! QCi . VP AR ! 1 ) ). ! SC2. VP AR! 2 > ) . ! 0C3 . VP AR ! 3 ) ) . 

!QT1 , VPAR! 4) >, !QT2, VPAR! 5 )>.! QT3 , VPAR!6 ) >. 

< AA. VPAR! 7 )).! BB. VPAR! 8) > ,! CC. VPAR! 9) ). 

!HEATN. VPAR! 10)>/!HEATH. VPAR! 1 1 ) >. ! HEATA. VPAR! 12> >. 
!PHCL. VPAR! 13) ).!PCO. VPAR! 14) ). ! PC0 2. VPAR! 15 ) >. 

!PAL2 03.VPAR!16)).!PNO.VPAR! 17 >).!GAMMAX.VPAR! 18) ) 
DIMENSION ILIME! 32). IDATAF! 1 0 ), I ERS! 32 ) . J J T I M! 5 > 

INPUT FORMAT STATEMENTS 


100 FORMAT 

101 FORMAT 

102 FORMAT 

103 FORMAT 

104 FORMAT 

105 FORMAT 

106 FORMAT 

107 FORMAT 

108 FORMAT 

109 FORMAT 

110 FORMAT 


! 12. IX. 2A2. 12) 

!A1 > 

!10A2) 

!I4.5XI2. 1XA2. Al. 1X14) 

!I4,3XI2. 1XA2.A1. 1X14) 

!I6.1XI3.1XF4.1.F6.1,F6.1.F7.2.11XF7.2) 
!I4.' C"A2.1XI2.1X.A2. Al. 1X.I4) 

! 12. IX. A2. Al .IX. 14) 

!F7. 2 ) 

! 12 ) 

!F4. 1 ) 


OUTPUT FORMAT STATEMENTS 


200 FORMAT ! ” 1 " 80! IN * )/ 1 X . 80 ! 1 H* ) /I X , 1 0! 1 H* > . 6 OX . 1 0 ! I H* ) / 

1X.10!1H*).“ NASA/MSFC MULTILAYER DIFFUSION MODEL - " 
"REED*4X“21 JUN 1977 • . 1 0! 1 H ♦ >7 1 X . 1 0! 1 H ♦ ) . 6 0 X. 1 0 ! 1 H * ) / 
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IX. 80< IH* )/lX. 80< IH*)/ 

"ORUN “I2« USING DATA FILE "3A2/ 

”0“3A2.A1* LAUNCH VEHICLE") 

201 FORMAT ("OLAUHCH TIME! " 1 4 . 1 X R 1 . A2 . 4 X " D AT E ! “ I 2 , 1 X A 2 . A 1 , 1 X I 4 > 

202 FORMAT ( ” OP R ED I C T 1 0 N TIME: "14“ C " A2 . 4X "0 A TE i " I 2 . 1 X A2 . A 1 . 1 X I 4 / 

"OOATA FILE HEADER INFORMATION!") 

203 FORMAT <"0<<<<0PEN ERROR "14". PROCESSING CONTINUES UITH " 

"NEXT RUN>>>>“ ) 

204 FORMAT <"0<<<<READF ERROR " I 4 " . PR OC E SS I H G CONTINUES WITH " 

"NEXT RUH>>>>" ) 

205 FORMAT <6X.40A2) 

206 FORMAT (“0"5X"TIME! " I 4. IXA 1 . A2 . 4X “D ATE i " 12 . 1 X A2 . A 1 . 1 XI 4 > 

207 FORMAT < * 1 * 8 0< 1 H S )7 1 X . 20 < 1 H S ) . 4 0 X . 20 < I H S ) / 

lX.20(iHS).16X"S0UNDIHG"16X.20(lHS)7 
1X.2 0<1HS). 40X.20( 1HS)/1X.80<1HS)//) 

208 FORMAT ( " 1 " 80< IHF )7 IX . 20< 1 HF ) , 40X. 20( IHF )/ 

1X.2 0(1HF).16X"F0RECAST”16X.2 0<1HF)/ 

IX. 20( IHF ). 40X.20< IHF )71X. 80( lHF)/7) 

209 FORMAT ("OSURFACE DENSITY (GM/M**3)! "F8.2) 

210 FORMAT <"OLAYER ALTITUDE DIRECTION SPEED TEMP 

"POT-TEMP D P TEMP PRESSURE"/ 

“ NO. (FEET) (METERS) (DEGREES) (M/SEC) 

"(DEGREES CENTIGRADE) (MILLIBARS)") 

211 FORMAT (2X12. 17. 2X15. 7X13. 5XF4. 1 .4XF4 . 1 , 4XF5 .2. 6XF4 . 1. 6XF5. 2) 

TYPE AND DIMENSION STATEMENTS 

INTEGER BLANKS . F I LE( 3 ) . FDIG IT( 50 ). RCHAR . TCHAR. SCHAR . 

VNAMES(4.3).RUHHUM.RA.F0.SDT.TE.ZER00,RCLDR(3) 

DIMENSION IPAR(5).VPARS(18.5).IDCB(272).IBUF(40),IALT(31). 
DPTEMP( 31 ). NAME( 3 ), NAMEF( 3 ) 

DATA STATEMENTS 


DATA NAME/036522B.2HEE. IHD/ 

DATA IERS/32*2H / 

DATA NAMEF/2H7R. 2HEE. IHD/ 

C 

C*** VPARSd THRU 18) = SHUTTLE (19 - 36) = TITAN ( 37 - 54 ) = DELTA 
C*** (55 - 72) = DELTA 3914 (73 - 90) = MIHUTEMAH 


C 


DATA VPARS/1 . 521923E7 . 6 . 882968E6 . 3 . 441484E6. 1 . 894794173E9 . 

8. 5692 95 16E8. 1.713 85 9 03 2E 9.. 65 221 29 891 .. 4 68 08 46. 

.37 5. 147 9. 7. 106 2. 35. 100 0.0. .1970. .22 34, .0316. .27 91. 
. 0002. .64. 

5. 437528 E6. 2. 718 76 4E6. 1.35 93 82 E6. 3. 2 62 516 8E 8. 

1 .631 258 4E8. 3 .26 251 68E8, . 429580469. . 5184223. 

5 .0 .2021 . 1 . 1010 . 55 . 1000 .0. . 1932. . 2665. . 0222. 
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. 2819, .0002, .64, 

8 .360685E5,9. 098UE4, 2. 72 9 434E5,2 .88 7598E7, 

3. 14229E6, 1 .8853 73E7, .922156, .432703, .54, 1766.0, 

1000.0. 690.0. .1866. .2055. .0156. .3391. .0002, 

.50, 

1 . 057557E6, 1 . 482923E5 , 3 . 70731E5 ,6 . 70269E7 , 

9. 398616 E6, 4. 69930 8E 7, 1.2457 56, .4180947, 

0.0,14 49.9,1000.0,411.18, .1866, 12055, .0156, .3391, 

. 0002, .50, 

4.684476E5,4.684476E5,1.171119E5,2.8106856E7, 

2. 8106 85 6E7, 2. 81 06 856E7,. 469 98 2, .46 3333, 0.0, 

2055.9.2055.9.1000.0, .1866, .2055, .0156, .3391, 

. 0002 , .64/ 

C 

DATft BLAHKS/2H /, RCHAR/IHR/, TCHAR/IHT/, SCHAR/IHS/, 

Rft/2HRA/, F0/2HF0/, SDT/2HDT/, TE/2HTE/, 2ER00/2H00/, 
NIHE9/2H99/, R CL D R/ 2H R C , 2H L D , 1 H R / 

DATA FDIGIT/2H01 , 2H02, 2H03, 2H04, 2H05, 2H06, 2H07, 2H08, 2H09, 2H10, 
2H11 , 2H12, 2H13, 2H14, 2H15, 2H16, 2H17, 2H18, 2H19, 2H20, 
2H21 , 2H22, 2H23, 2H24, 2H25 , 2H26, 2H27, 2H28, 2H29, 2H30, 
2H31 , 2H32, 2H33, 2H34, 2H35, 2H36, 2H37, 2H38, 2H39, 2H40, 
2H41 , 2.H4 2, 2H43, 2H44, 2H45, 2H46, 2H47,2H48,2H49, 2H50/ 
DATA VNAHES/2HSH, 2HUT, 2HTL, IHE, 

2HTI , 2HTA, IHN, IH , 

2HDE, 2HLT, IHA, IH / 

CALL GRAF TO INITIALIZE SCOPE (ONLY APPLICABLE IF USING 
PLASHASCOPE) 

CALL GRAF< 1 ) 

FIND THE LOGICAL UNIT NUMBER OF THE DEVICE TO BE USED FOR 
INPUT AND SET THE VARIABLE LU EQUAL TO IT 

CALL RMPAR< IPAR) 

LU = IPAR< 1 ) 

BEGIN PROCESSING OF NEU DATA BY CLEARING SCOPE 
1 CALL CLEAR 

INITIALIZE SOME COMMON VARIABLES 

LTIME = .FALSE. 

YES = IHY 
PI * 3 . 141593 
PI0VR2 = 0.5 * PI 
PI43 = 1.3333333 ♦ PI 
THOPI = 2 .0 ♦ PI 
SQR2PI = SQRT< TUOPI ) 
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DEGRAD = PI/180.0 
RADDEG = 180.0/PI 
DO 2 1=1. 3 
2 IOPT< I > = 0 
JBOT = 0 
Z B = 0 . 0 
ZZ = 0 . 0 
REFLEC = 1.0 

WRITE; TH:E HEADER OF, THE CONSOLE 

CALL CLEAR 
YPOS = 490. 

CALL DREAD( HAHEF . 2. ILINE > 

CALL LERS<YPOS) 

CALL CHAR<0. . YPOS, O.ILIHE. 64.0.0) 

CALL GETTD< LTIM. LDAY. LHOH. LYEAR ) 

CALL CODE 

yRITE < IDATAF. 107 ) LD AY . LM 0 N , L Y E AR 
CALL CHAR< 368 ., YPOS , 0 , IDATAF, 11 , 2. 0 ) 

YPOS = YPOS - 32. 

READ IH THE NUMBER OF RUNS TO BE MADE AND THE FIRST FOUR 
CHARACTERS OF THE DATA FILE NAMES FOR THOSE RUNS 

CALL OREAD< NAMEF , 3, ILINE ) 

CALL LERS<YPOS) 

: CALL CHAR< 0 . , YPOS , 0 , IL INE. 43, 3, 0 ) 

CALL CHAR< 384 . . YPOS , 0. IL INE< 25 ), 8, 3. 0 > 

CALL CHAR< 464. , YP0S,0. ILINE(30), 6, 0, 0 ) 

CALL INC1,JTYPE,0.,0.,0,0,0,0,31,0,31,IX,IY) 

CALL CHAR<0. , YPOS, 0, ILINE. 64, 0,0) 

IF<IX LE. 25)CALL C H A R( 46 4 . . Y P 0 S , 0 , I ER S , 6 , 0 , 0 ) 

IF<IX .GT. 25)CALL CH A R( 38 4 . , YP 0 S , 0 . I ER S , 8 , 0 , 0 > 

YPOS = YPOS - 32. 

IF< IX . GE . 28 ) lOPTC 2 ) = 1 
IF< I0PT<2 ) . EQ . 0 )G0 TO 4 
CALL DREAD( NAMEF , 4, IL INE ) 

CALL LERS( YPOS ) 

CALL CHAR< 0 . , YPOS ,0 . IL INE, 64. 0. 0 > 

YPOS = YPOS - 16. 

CALL DREAD< NAMEF , 5. IL INE > 

CALL LERS<YPOS) 

CALL CHAR<0. , YPOS, 0, ILINE. 22, 3.0) 

NIN = 9 

CALL BLANK< I DATAF , 1 0 ) 

CALL I N(0,JTYPE, 175.. YPOS. 0, IDATAF, NIN. 0.31, 0.31, IX, lY) 

CALL CHAR<0. ,YP0S,0,ILINE,22,0,0) 

YPOS = YPOS - 32. 

CALL CODE 
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READ (IDATAF<100> N UMR UN . F I LE< 1 > i F I L E( 2 > . I FO FF 
HUHRUH » HlNO<HAXO<NUHRUH. 1 50 > 

IFUFOFF .GT. OMFOFF = IFOFF 1 

IF(F1LE(1> .NE. BLANKS)GO TO 5 

FILEd > = 2HDA 

FILE<2) = 2HTA 

IFOFF =0 

NUMRUH =1 

IF< HUMRUN + IFOFF . GT . 50)NUHRUN,-= 5.0 - IFOFF 
IFOFFl = IFOFF + I 
IFLAG< 3 ) = 0 

IF<F ILE< 1 > . EQ. 2HVA .AND. F I LE ( 2 ) . E Q . 2 HH D ) I FL AG ( 3 > =1 
IFCFILEU ).EQ.2HTA .AND. F I LE< 2 ) . EQ . 2HPE ) I FLAG< 3 ) = 2 
IF<FILE<1 ).EQ.2HDA .AND. F I LE < 2 ) . E Q . 2 NT A ) I FL AG ( 3 ) = 3 
IFLAG<4) = IHE 

IF<IFLAG(3) .EQ. 1)IFLAG(4) = LHP‘ ‘ 

FIND OUT IF THESE RUNS ARE tO BE RESEARCH RUNS (INTERACTION 
AND PLOTTING ALLOWED) OR PRODUCTION RUNS 

CALL DREADC NAHEF , 7-ILI NE ) i 

CALL LERS(YPOS) , ■ ; 

CALL CHARtO . , YPOS lO , IL INE. 1 1 . 3i 0 ) 

CALL CHAR(128. ,YP0S,0. ILIHEO)/ 12.3.0) ! : • 

CALL CHAR(240. , YPOS.O. ILINE( 16). 32.Q.0) . , ■ 

CALL INC 1 , J T YPE. 0 . , 0 . . 0/ 0. 0 . 0 , 31 . 0. 31:. I X.I Y ) 

CALL CHAR< 0 . . YPOS . 0 . ILIHE. 6 4. 0. 0 ) , . , ' 

IFdX .LT. 12)CALL CH A R< 22 4 . . YP 0 S . 0 . I ER S . 3 4 , 0 . 0 > 

IF< IX . LT . 12)IFLAG( 1 ) = 1 

IF(IX.GE.12 ,AHD. I X, LT . 19 )CALL CH AR < 1 2 0 . . YP OS . 0 . I E R S . 1 6 . 0 , 0 ) 
IFdX. GE. 12 .AND. IX.LT.19;)IFLAGd) = 2 

IFdX. GE. 12 .AND. I X . L T . 1 9 ) C A LL' CH AR < 36 8 . . YP OS . 0 . I E R S . 1 6 . 0 . 0 ) 

IFdX .GE. 19)CALL CH A R( 1 2 0 . , YP 0 S . 0 . I ERS . 3 0 . 0 . 0 ) 

IFdX . GE . 19)IFLAGd ) = 3 ’ ' 

YPOS = YPOS - 32 . ; . . 

IFdX . LT . 1 9 ) lOPTC 2 ) = 1 

IF( I0PT<2 ) . EQ . 0 )G0 TO 7 - : • 

GO TO 12 
CONTINUE 

FOR PRODUCTION RUNS. READ IN THE TOP OF THE SURFACE LAYER 

AND THE SIGMA OF THE HIND AZIMUTH ANGLE TO BE USED FOR ALL RUNS 

CALL DREAD( NAMEF. 11 , ILIHE) 

CALL LERS(YPOS) 

CALL CHAR(0..YPOS.O,ILINE.33.3.O> 

HIN = 6 

CALL BLANKC I DATAF , 1 0 ) 

CALL INC0.JTYRE.263..YP0S.0.IDATAF.NIN.0. 31.0.31.IX.IY) 

CALL CHAR(0.,YP0S.0. ILIHE. 33. 0.0) 
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CALL CODE 

READ (IDATAFilOS) TOPSUR 
YPOS = YPOS - 32. 

CALL DREADCHAHEF. 12iILINE> 

CALL LERS<YPOS> 

CALL CHAR<D. ,YPOSiO,ILIHE/37,3,0) 

HIN *2 

CALL BLAHK< IDATAF,10) 

CALL IN<0, J TYPE, 295 . , YPOS, 0 , 1 D A T AF , M I H , 0, 3 1 , 0 , 3 1 , IX, lY ) 

CALL CHAR<D. ,YP0S,0, ILIHE, 37, 0, 0 > 

CALL CODE 

READ ( IDATAF,109> ISIGA 
IFCHIH.EQ.l) ISIGA = ISIGA/10 
SIGA e FLOAT(ISIGA) 

YPOS « YPOS -32. 

READ IN AMD WRITE OUT THE LAUNCH TIME AMD DATE -- IF MOT 
ENTERED, DO MOT WRITE ANYTHING OUT 

12 CALL DREAD< NAHEF, 8, ILIHE > 

CALL LERS(YPOS) 

CALL CHAR<0 . ,YP0S,0, ILINE, 28, 3,0 ) 

CALL CHAR(384. /YPOSiO, ILINE<25), 8, 3, 0 ) 

CALL CHAR<464.,YP0S,0,ILIHE<30),6,0,0> 

CALL GETTD< LTIM, LDAY, LMON, LYEAR ) 

CALL CODE 

WRITE <IDATAF,106> LT I M , SO T , L D A Y , L MO H , L YE A R 
CALL CHAR(224 . , YPOS ,0, IDATAF, 20, 0, 0 ) 

CALL INC1,JTYPE,0.,0.,0,0,0,0,31,0,31,IX,IY> 

CALL CHAR<0.,YPOS,0, ILINE, 28, 0,0) 

CALL CHAR(384.,YP0S,0,ILIME<25), 15,0,0) 

IF<IX LE. 25)CALL CH A R( 46 4 . , YP OS , 0 , I ER S , 6 , 0 , 0 ) 

IF(IX .GT. 25)CALL CH A R( 38 4 . , Y P 0 S , 0 , I ER S , 8 , 0 , 0 ) 

YPOS = YPOS - 32. 

IFCIX .LE. 25)G0 TO 17 
CALL DREAO( NAMEF, 9, ILINE ) 

CALL LERSCYPOS) 

CALL CHARCO . , YPOS, 0, ILINE, 26, 3, 0 ) 

NIN = 20 

CALL BLANK< IDATAF, 10) 

CALL IH<0, JT YPE, 2 07. ,YP0S,0, IDATAF, NIN, 0,31, 0,31, IX, lY) 

CALL CHAR<0.,YP0S,0, ILINE, 26, 0,0) 

CALL CODE 

READ (IDATAF, 102) < LAUNTD< I ), 1 = 1 , 1 0 ) 

YPOS = YPOS - 32. 

IF<LAUHTD(1) .EG. BLANKS)GO TO 17 
LTIME = . TRUE. 

CALL CODE 

READ < L AUNT D, 103 > LTIM, LDAY, LMON, LYEAR 
CO TO 21 
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READ IN THE LAUNCH VEHICLE. LET IT DEFAULT IF NOT ENTERED. 
HRITE IT- BACK OUT. AND FILL THE VPAR ARRAY WITH THE 
APPROPRIATE VEHICLE PARAMETERS 

21 CALL DREAD(NAHEF. lO.ILINE) 

CALL LERS(YPOS) 

CALL CHAR(0 . . YPOS.O. ILIHE. 24. 3. 0 > 

CALL CHAR< 192. .YPOS.O. ILIHE( 13). 24,0. 0) 

CALL CHAR(416..YP0S.0.ILINE<27).11.3.0) 

CALL INC 1 . J TYPE. 0 . , 0 . . 0. 0. 0 . 0 . 31 .0 . 31 . IX. I Y ) 

CALL CHARCO . .YPOS.O. ILINE. 64. 0. 0 ) 

IFCIX .LE. 15)CALL CH A R< 31 2 . . YP 0 S . 0 . I ER S . 2 4 . 0 . 0,) 

IFCIX.GT.IS .AND. I X . LT . 24 )CA LL CH AR ( 1 9 2 . . YP OS . 0 . I E R S . 1 2 . 0 . 0 ) 
IFCIX.GT.IS .AND. I X . LT . 24 ) C ALL CH AR < 4 1 6 . . YP OS . 0 . I E R S . 1 1 . 0 . 0 ) 
IFCIX .GE. 24)CALL CH A R< 1 9 2 . . YP 0 S . 0 . I ER S . 2 4 . 0 , 0 ) 

YPOS = YPOS - 32. 

IFCIX .LE. 15)G0 TO 25 
IFCIX .LE. 23>G0 TO 24 

N 

IF I0PTC3) = 0 


C ♦ * * • ♦ 


A SHUTTLE LAUNCH. 


1)1 


THEN IT IS 

I0PT<3 > = 0 
CO TO 26 ' 

C****4. IF I0PTC3) = 1 THEN IT IS A TITAN LAUNCH. >***»:** 

24 I0PTC3) =1 
GO TO 26 


C * * ♦ ♦ * 


IF I0PT<3) 


THEN IT IS A DELTA LAUNCH 


***** * 


25 I0PT<3) = 2 

26 I = I0PT<3) + 1 
C 

C FILL THE VPAR ARRAY 

C 

DO 28 J=1 , 18 
28 VPARC J ) = VPARSC J , I ) 


C 

C CHANGE IN BOTTOM LAYER WITH TOTAL REFLECTION? 

C 

CALL DREADC NAMEF. 15, ILINE) 

CALL LERS(YPOS) 

CALL CHARCO., YPOS.O. ILINE, 64, 0,0) 

YPOS = YPOS - 32. 

CALL DREADC NAMEF. 16 , ILINE) 

CALL LERSC YPOS ) 

CALL CHARC 32 . . YPOS. 0. ILINEC 3 ) . 1 1 , 3, 0 ) 
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CALL CHAR<160. .YPOSiO. 1LIHE(11)<43.0.0> 

CALL 1N< 1 . JTYPE< 0 . . 0. < 0< 0. 0 >0 /31 I&/31 . IX> I Y> 

CALL CHAR(0 . / YPOS.Oi IERS.64,0. 0 ) 

YP » YPOS 

YPOS = YPOS - 32.0 

CHECK FOR SURFACE -- STABI LI ZAT lOH -- SOMETH IHC ELSE 

IFCIX .GE. 8>G0 TO 29 
IFLAG< 2) = 0 

CALL CHAR<0.0, YP,0. ILINE, 16,0,0) 

GO TO 38 

29 IFUX .GE. 20)G0 TO 30 
IFLAG< 2 ) = 1 

CALL CHAR< 160 . 0, YP, 0, ILINE( li ), 16, 0, 0 ) 

JBOT =2 

ZB = ALT< JBOT) 

GO TO 38 

DEFAULT HEIGHT CALCULATION Zt?' 

30 IFLAG<2) = 2 

CALL CHARC320 . 0, YP, 0, ILIHE< 20 ), 18, 0, 0 ) 

CALL OREAD< HAMEF, 17, ILIHE) 

CALL LERS< YPOS ) 

CALL CHARCO . , YPOS ,0, ILIHE, 42, 3, 0 ) 

CALL CHARC384. ,YP0S,0, ILIHE(25), 8, 3, 0 > 

CALL CHAR(464 . , YPOS ,0 , ILIHE< 30) , 6, 0, 0 ) 

CALL INC 1 , JTYPE, 0 . , 0 . , 0, 0, 0 , 0 , 31 , 0 , 31 , IX, I Y) 

CALL CHARCO ., YPOS , 0 , lERS , 42 , 0, 0 ) 

CALL C H AR CO. ,YP0S,0, ILIHE, 42, 0,0) 

IFCIX .LE. 25)G0 TO 37 

CALL CHARC 384. , YP0S,0, lERS, 8, 0, 0 ) 

YPOS = YPOS - 32 . , 

ENTER HEIGHT Zz 

CALL DREADC NANEF, 18, ILIHE) 

CALL LERSCYPOS) 

CALL CHARC47 . , YPOS, 0, ILINEC 4 ), 10 , 3, 0 ) 

NIN = 6 

CALL BLAHKC IDATAF , 1 0 ) 

CALL INC0,JTYPE,128.,YP0S,0,IDATAF,NIN,0,31,0,31,IX,IY) 
CALL CODE 

READ C IDATAF,* ) ZZ 

CALL CHARCO. , Y PO S , 0 , I E RS , 1 6 , 0 , 0 ) 

CALL CHARC47.,YP0S,0,ILINEC4),10,0,0) 

YPOS = YPOS - 32. 

ENTER SURFACE REFLECTION? 
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CALL DREADC NAHEF> 19i ILINE) 

CALL LERS<YPOS) 

CALL CHAR(0.iYP0S,0,ILIHE. 45.3.0) 

CALL CHAR<383..YP0S.0.ILIHE(25>.8.3.0) 

CALL CHAR<472..YP0S.0.ILIHE(30).8.0.0> 

CALL IH<1.JTYPE.O.,0.,0,0.0.0.31.0.31.IX.IY) 

CALL CHAR(0..YP0S.0.1LINE.84.0.0> 

IFUX .LE. 25)REFLEC = 1 .0 

IFCIX .LE. 25)CALL CHAR( 464 . . YPOS. 0. I ERS. £ . 0 . 0 > 

IFCIX .LE. 25)G0 TO 34 

CALL CHAR<384.0.YPOS.O.IERS.8.0.0) 

YPOS = YPOS - 32. 

WRITE OUT Rf VALUES FOR SELECTION 

CALL DREAD( NAHEF . 20. I LINE) 

CALL LERS<YPOS) 

CALL CHAR<0..YP0S.0>ILIHE.64.3.0) 

HIH = 4 

CALL BLANK( IDATAF .10) 

CALL IH(2.JTYPE.440..YP0S.O,IDATAF.NIN.0.31.0.31.IX.IY> 
IF<JTYPE .NE. 0)GO TO 31 
CALL CODE 

READ ( IDATAF.*) REFLEC 


GO TO 

32 



IX = 

IX/2 



IF< IX 

EQ. 

1 )REFLEC = 

0.8 

IF( IX 

. EQ . 

3)REFLEC = 

0.7 

IF( IX 

. EQ . 

5)REFLEC = 

0 . 5 

IF< IX 

. EQ . 

7)REFLEC = 

0.3 

IF( IX 

. EQ . 

9)REFLEC » 

0. 1 

IF< IX 

.EQ. 

1 1 )REFLEC 

= 0.0 

CALL 

CODE 




WRITE (IDATAF. 110) REFLEC 
32 CALL CHAR(0 . . YPOS.O. IERS.64.0.0 ) 

CALL CHAR<48 . . YPOS. 0. ILINE. 6, 0. 0 ) 

CALL CHAR<88 . . YPOS. 0. IDATAF.4.0. 0) 

IF< JTYPE HE . 0)G0 TO 34 
CALL CODE 

READ ( IDATAF.* ) REFLEC 
34 YPOS « YPOS - 32. 

DEFAULT HEIGHT OF BASE LAYER? 

CALL DREAD< NAHEF. 21 . ILINE) 

CALL LERS(YPOS) 

CALL CHARCO.. YPOS.O. ILINE. 46. 3.0) 

CALL CHAR(384..YP0S.0.ILIHE(25>.8.3.0) 
CALL CHAR(464. .YPOS.O. IL1NE(30). 6. 0.0 ) 
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CALL IHtl,JTYPE/0.i0.,0.0,0,0,31,0,31,IX/IY) 

CALL CHAR<0./YPOS,0,ILIHE,64.0,0) 

IF<IX . LE . 25)CALL CHAR< 464 . , YPOS/ 0, I ERS. 6 i 0 , 0 ) 

rP<IX .LE. 25)G0 TO 36 

CALL CHAR<384..YP0S,O.IERS.8.O.O> 

YPOS « YPOS - 32. 

CALL DREAD<NAHEF,22,ILIHE> 

CALL LERS(YPOS) 

CALL CHAR< 47 . > YPOS. 0. ILINE< 4 ), 10,3, 0 ) 

ENTER HEIGHT OF BASE LAYER 
NIN = 6 

CALL BLANK< IDATAF , 10) 

CALL IH<0, J TYPE, 1 44 . , YPOS, 0 , rOATAF,H IH, 0, 31, 0, 31 , IX, lY ) 

CALL CODE 

READ < IDATAF , * > ZB 

CALL CHAR<47.,YP0S,0,ILINE<4),10,0,0) 

YPOS = YPOS - 32. 

GO TO 38 

36 ZB = 0 . 0 
GO TO 38 

37 CALL CHAR< 0 . , YPOS , 0 , lERS , 64 , 0 , 0 ) 

CALL CHARCO . , YPOS ,0 , IL INE, 58, 0, 0 ) 

YPOS = YPOS - 32. 

38 CONTINUE 

DO LOOP ON THE RUN HUMBER 
DO 79 RUNHUM=1 ,NUMRUN 

SET UP THE FILE NAME FOR THIS RUN, GET THE CURRENT TIME, 
AND WRITE OUT THE HEADER 

FILE<3) = FDIGIT<RUNNUM+IFOFF) 

CALL GETTDC ITIME, IDAY, MONTH, lYEAR) 

I = I0PT<3> + 1 

WRITE ( 6, 200 ) RUNNUM, ( FILE< J ) , J = l, 3) , < VHAMES( J , I ) , J = 1, 4 ) 
IF(LTIME)WRITE (6,201) LTIM,LAUNTD(3),LAUHTD(4),LDAY,LM0N(1), 

LM0N(2 ), LYEAR 

WRITE (6, 202 ) I T I ME , L A UN TD ( 4 ) , I D A Y , M 0 NT H , I YE AR 

IF THE DATA IS OH A DISK FILE, READ FROM DISK -- IF IT 
IS ON TAPE, READ IT AS KSC 1965 DATA IN SUBROUTINE KSC6S 

IF(IFLAG(3) .HE. 2)G0 TO 39 

CALL KSC65(IBUF,IALT,DPTEMP,IF0FF1,IE0F) 

IFOFFl = 1 

IF( lEOF . EQ . 1 )C0 TO 81 
IFdEOF .EQ. 2)G0 TO 79 
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GO TO 48 


OPEN THE DATA FILE FOR THIS RUH 

39 CALL OPEN<IDCB.IERR,FILE>0,0,0,272) 

IF<IERR .GE. 0)G0 TO 40 

WRITE <6,203) lERR 
GO TO 79 

READ THE HEADINGS FROM THE DATA FILE, SETTING UP 
APPROPRIATE PARAMETERS 

40 CALL READFC IDCB, lERR, IBUF, 40, LEN > 

IF< lERR . GE . 0 )G0 TO 42 

41 WRITE <6,204) lERR 
GO TO 79 

42 IF<IBUF<1) .NE. TE)G0 TO 40 

43 WRITE < 6,205 ) < I B UF < I ) , I =1 , LE N ) 

CALL READF<IDCB,IERR,IBUF,40,LEN) 

IF< lERR . LT . 0 )G0 TO 41 

IF< IBUF< 1 ) . NE . RA .AND. I BUF< 1 ) . NE . FO )G0 TO 43 
IOPT< 1 ) = 0 

IF<IBUF<1) .EQ. F0)I0PT<1) = 1 
WRITE < 6,205 ) < I BUF< I ) , I =1 , LEN ) 

CALL READF< IDCB, lERR, I8UF, 4 0, LEN ) 

IF<IERR .LT. 0)G0 TO 41 

WRITE < 6,205 ) < I B UF < I ) , I *1 , LE N > 

READ THE SO UN D I N G/ F OR EC AST TIHE 

CALL READF< IDCB, lERR, IBUF, 9 ) 

IF< lERR . LT . 0 )G0 TO 4 1 
CALL CODE 

READ <IBUF,104) I ST I « , I S D A Y , I SM 0 N< 1 ) , I S MO H < 2 ) , I S Y E A R 
CHANGE TO EST OR EDT DEPENDING OH LAUNCH TIME 
ISTIM = ISTIM - 500 

IF<IFLAG<3) .EQ. DISTIM = ISTIM - 300 
IF<LAUNTD<4) . NE . 2HST)ISTIM = ISTIM + 100 
IF< ISTIM .GT . 0)G0 TO 44 
ISTIM = 2400 + ISTIM 
ISDAY = ISOAY - 1 

WRITE OUT THE NEXT LINE OF THE HEADER 

44 CALL READF< IDCB, lERR, IBUF, 40, LEN > 

IF< lERR . LT . 0 )G0 TO 41 

WRITE < 6, 205 ) < I B UF < I ) , I =1 , LE H ) 


THE 
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C WRITE OUT THE SO U N D I H G/ F OR EC A ST TIME 

C 

WRITE <6.20S) ISTIM.IFLAG(4),LAUNTD<4>.ISDAY.ISM0N<1).ISM0K<2). 
ISYEAR 

FIHD THE FIRST DATA POINT WITH AN ALTITUDE OF 10 FEET 
OR ABOVE 

45 CALL READF< IDCB. lERR. IBUF. 40. LEH > 

IF( lERR . LT . 0 )G0 TO 41 
CALL e-2Z< IBUF< 1 ). J ) 

IF<J.LT.ZER00 .OR. J.GT.NINE9)G0 TO 45 
CALL CODE 

READ (IBUF.105) I AL T( 1 ) . I D I R( 1 ) . SP EE D ( 1 ) . T EM P< 1 ) .. DP T EM P< 1 ) . 

PRESS< 1 >. 3URDEN 
IF< lALTC I ) . LT . 10)G0 TO 45 

TRY TO FIND A TOTAL OF 30 DATA POINTS WITH ALTITUDES 
BETWEEN 20 FT AND 10.000 FT INCLUSIVE 

HUM = 1 
DO 47 1=2,30 

46 CALL RE ADF( I DCB. I ERR. I BUF. 40. LEN ) 

IFCIERR.LT.O .AND. I E R R . NE . - 1 2 ) G 0 TO 41 
IF<LEN .EQ. -1 )G0 TO 48 
CALL B2Z< IBUF< 1 ) . J ) 

I F( J . LT . ZEROO .OR. J . GT . NI NE9 )G0 TO 46 
CALL CODE 

READ <1BUF.105) I AL T( I > . I D I R( I ) . SP EE D < I ) . T EM P( I ) . DP T EM P< I) . 

PRESSC I ) 

I F< I ALT( I ) . LT . 20 .OR. I A L T ( I ) . G T . 1 0 0 0 0 ) GO TO 46 
4 7 H U M = I 

ZERO OUT THE REMAINING ELEMENTS OF THE ARRAYS 

48 HUMl = NUM + 1 
IF<NUM1 .GT. 30)GO TO 51 
DO 4 9 I =HUM 1 , 30 
ALT( I ) = 0.0 
ID IR< I ) = 0 
SPEED< I > = 0.0 
TEMP< I ) = 0.0 
DPTEMPC I ) = 0 . 0 

49 PRESSC I > = 0 . 0 

CONVERT TO METRIC UNITS 

51 DO 52 1=1 ,NUM 

ALTCI) = 0.3048 * F LO A T < I A L T ( I ) ) 

52 .SPEED<I) = 0.515 * SPEED<I) 


A-77 



ooo ooooon oooo 


SORT ALL THE DATA POINTS SO THEY APPEAR 1 H ASCENDING 
ORDER OF ALTITUDE 

HUHl « HUH - 1 
DO 58 I=*1.HUH1 
JJ » HUH - I 
DO 57 J»1 . J J 
J1 * J + 1 

IF<ALT<J) .LE. ALT<J1)>G0 TO 57 
ARG = ALT< J ) 

ALT<J> = ALT<Jl) 

ALT(Jl) = ARG 
lARG s IDIR(J) 

IDIR< J ) » IDIRCJl ) 

IDIR< J 1 > = lARG 
ARG = SPEED(J) 

SPEED< J ) = SPEEIXJl > 

SPEED(Jl) = ARG 
ARG = TEHP< J ) 

TEHP< J ) = TEHP< J 1 > 

TEMP( J 1 ) = ARG 
ARG = 0PTEHP< J ) 

OPTEMP(J) = DPTEHP(Jl) 

DPTEHP< J1 ) * ARG 
ARG s PRESS<J) 

PRESS< J ) = PRESS< 41 ) 

PRESS(Jl) - ARG 

57 CONTIHUE 

58 CONTINUE 

CALCULATE THE POTENTIAL TEMPERATURE 
DO 62 1=1 ,NUH 

62 PTEHP(I) = <TEMP<I) + 273.15) * ( ( 1000 . O/PRESSC I ) )**0 . 288 ) 

WRITE THE HEADER FOR SOUNDING OR FORECAST 

IF< IOPT< 1 ) . EQ . 1 )G0 TO 64 
WRITE ( 6/ 207 > 

GO TO 65 

64 WRITE < 6. 208 ) 

WRITE THE SURFACE DENSITY AND ALL THE DATA POINTS 


65 


WRITE <6.209) SURDEH 
WRITE <6.210) 

DO 68 1=1 .NUn 

lALTF = 3.281 ♦ ALT< I ) + 0.5 
I ALTM = ALT< I ) + 0.5 
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APTEMP = PTEMP(I) - 273.15 

68 WRITE <6.211> I . I AL TF > I ALTH > I D I R< I > / SPEED ( I > . TEHPC I > , 

APTEMP, DPTEMP< I >. PRESSt I ) 

CLOSE THE DATA FILE 

CALL CLOSE! IDCB) 

TRANSFER TO THE PROGRAM RCLDR -- THE CLOUD RISE PROGRAM 

CALL NGRAF 

CALL RUDIS<HAME, 1 > 

CALL EHECO, RCLDR) 

CALL RUDI S< NAME, 0 ) 

CALL GRAF! 1 ) 

PROCESS THE HEXT RUH 

73 COHTINUE 

TERMINATE OF PROCESS MORE DATA? 

81 CALL DREADCNAMEF, 14,ILIHE) 

CALL LERS!.YP0S) 

CALL CHAR(C'.,YPOS,0,ILINE!1),24,3,0) 

CALL CHAR< 224 , . YPOS , 0, ILINE! 1 5 ) , 14 , 3 , 0 ) 

CALL CHAR<352.,YP0S,0,ILIHE!23),12,0/O) 

CALL IN<1/JTYPE,0.,0.,0,<>,0,0,31,0,31,IX, lY) 

I F< 1 X . LT . 20 )G0 TO 82 

PROCESS MORE DATA 

CALLLERS(YPOS) 

CALL CHAR<0.,YPOS,0,ILINE!l),28,0,0) 

CALL CHAR< 352. ,YP0S,0,.ILIME(2 3>, 12,0, 0) 

YPOS = 453. 

G 0 T 0 1 . 

TERMINATE EXECUTION 

82 CALL DREAD(NAMEF, 13.1LIHE) 

CALL LERS(VPOS) 

YPOS = YPOS - 32. 

CALL CHAR!0. , YPOS, 0,1 LINE, 64, 3,0) 

DELAY BEFORE CLEARING SCOPE 

CALL EXECd 1 , JJTIM) 

JJ=JJTIM<2) 

IF(JJ.GT.55)JJ=5 


A -7.9 



oooooo ooo ooo 


85 CALL EXEC< I 1 . JJTIM) 

IF<JJ+5 .GT. JJTIM<2))G0 TO 85 

REINITIALIZE SCOPE NORMAL OPERATION AND STOP 

CALL HGRAF 
STOP 

END OF REED 


END 

SUBROUTINE KSC65<1BUF.IALT,DPTEMP.I«ANT,IE0F) 

THIS SUBROUTINE READS IN DATA FOR THE REED DIFFUSION 
MODEL FROM MAG TAPE IN KSC 1S65 FORMAT 


C 

C COMMON BLOCK 

C 

COMMON ALT<31).AL1,C0NMAX/C0NCPK.0EGRAD-ADIR,D0SPK,E1<CLDHT, 

IDIR<3I).I0PT<3).ITIME.IDAY.M0NTH(2).IYEAR-ISTIM,ISDAY. 
ISMOH<2).ISY£AR,IV2,JTOP,JBOT.LAUNTD(10),LTIME.LTIM;LDAY, 
LM0N<2).LYEAR.LU,NUM,PI,P10VR2,PI43.PRESS(31)-PTEHP<31), 
SIGHCL.RADDEG,RAT0MC,CLDRAD,R2,R3.SAVEA(30);SAVER<30),SIGA, 
SIGX0,SIGX.SPEED<31)/SQR2PI.SURDEH.SIGZ0,SIGAP,S8,TEMP(31). 
T0PSUR.TU0PI,ASP0,VPAR<I8).CRTIME<31).D1ST,YES,Y1,HUMRUN, 
YPOS, IFLAG(5)iZB.ZZ.REFLEC, IRETRN 
LOGICAL LTIME 
INTEGER YES 

EQUIVALENCE <QC1.VPAR<1))/<QC2.VPAR<2)).(QC3,VPAR<3)). 

< QT 1 , VP AR< 4 ) ) / ( QT2. VPAR< 5 > :< , f. QT3 . VP AR( 6 > ), 

( A A , V P A R '! 7 ) ) , C B B , V P A R <; 8 ) ) , ( C C V P A R ( 9 ) ) . 
(HEATN,VPAR<10)>, CHEAT M/VPAR<11)>/CHEATA,VPAR<12)), 
<PHCLiVPAR<13))APC0,VPAR(14I),(PC02.VPAR(15)), 
<PAL203,VPAR<16)),(PN0,VPAR<17. )><(:GAHMAX.VPARC18)) 

C 

C INPUT FORMAT STATEMENTS 

C 

1000 FORMAT (40A2) 

1001 FORMAT < I 4. 5X1 2. 1 XA2/ A 1 , IX I 4 ) 

1 002 FORMAT (. 1 X I 6 . 3 X I 3 . 5 XF 3 . 0 / 2 X F5 . 1 , 3X F 5 . 1 , 3X F 6 . 1 , 1 5X F 6 . 1 ) 

C 

C OUTPUT FORMAT STATEMENT 

C 

2000 FORMAT < " 0 " 5 X " T I M E : , " I 4 , 1 X A 1 , A2 , 4X " D A T E ! " I 2 . 1 X A2 , A 1 , 1 X I 4 ) 

C 

C DIMENSION STATEMENT 
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c 


D I HENS I ON IBUF<1 >,IALT(1 >/DPTEHP<l >. 


INITIALIZE THE COUNTER FOR THE NUHBER OF SETS OF DATA TO 0 
IGOT = 0 

READ DATA FROH TAPE 

4 READ <8,1000> < I B UF < I ) , I = 1 , 40 ) 

IF AN EOF ON TAPE. SET THE EOF FLAG AND RETURN 

CALL EXEC(13.8.IEQT5> 

lEOF B IAND< ISHI F< I EQT5. -7 ) , 1 > 

IF( lEOF . EQ . 1 >RETURH 

KEEP READING UNTIL THE STANDARD LEVEL DATA IS FOUND 

IF<IBUF<2) .NE. 2HST)G0 TO 4 
7 READ (8il 000 ) < I B UF < I ) , I = 1 . 40 > 

IF< IBUF< 1 ) . NE . 2HCA .OR. I B U F< 2 ) . E8 . 2 H ST )G 0 TO 7 

READ THE SO UN D I N G/ F OR EC A ST TIME 

READ (8,1001) 1ST IM , I SDAY. I SMOH< 1 ) , I SMON( 2 >, ISYEAR 

CHANGE TO EST OR EDT DEPENDING ON LAUNCH TIME 

ISTIM = ISTIM - 500 

IF(IFLAG<3) .EQ. DISTIM = ISTIM - 300 
IF(LAUHTD(4) . NE . 2HST)ISTIM = ISTIM + 100 
IF( 1ST IM .GT . 0)G0 TO 11 
ISTIM = 2400 + ISTIM 
ISDAY = ISOAY - 1 

FIND THE KEY WORD ALTITUDE 

11 READ ( 8,1000 ) ( IBUF( I ), 1=1 , 40 ) 

1F(IBUF<2) .EQ. 2HST)G0 TO 7 
IF(IBUFd) .NE. 2HADG0 TO 11 

LIMIT DATA TO 30 POINTS -- READ THE STANDARD LEVEL DATA 

DO 19 1=1,30 

15 READ ( 8,1 002 ) I A L T( I ) , 1 D I R ( I ) , S P EE D( I ) , TE M P( I ) , DP TE M P( I ) , PR ES S ( I ) , 

SURDH 

IF(SPEED( I ) . EQ .999. 0 .OR. I D I R( I ) . EQ . 99 9 ) G 0 TO 15 
IFCIDIRd) .EQ. 3S.0)IDIRd) = 0 
IFd . EQ . 1 )SURDEN = SURDH 
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IFOALKI) .GT. 1 0000 )G0 TO 22 
19 CONTINUE 
22 NUN = I 

IFCNUH .GT. 30)G0 TO 34 

FIND THE. KEY WORD MANDATORY 

25 READ (8,1 000 ) < I B UF ( 1 ) , I = 1 , 40 ) 

IF<IBUF<2) .EQ. 2HST)G0 TO 7 

I F( IBUF< 10 ) . NE . 2H0R .AND. I BU F< 1 5 ) . N E . 2 HO R )G 0 TO 25 
READ (8.1000) I 

LIMIT DATA TO 30 POINTS — READ THE MANDATORY LEVEL DATA 
DO 29 I=NUM,30 

27 READ ( 8,1 002 ) I A L T( I ) , I D I R ( I ) , S PEE D( I ) , TE M P( 1 ) , DP TE M P( I ) , PRES S ( I ) 
IF< SPEED( I ) . EQ . 999. 0 .OR. I DIR( I > . EQ . 999 )G0 TO 27 
IF(IDIRd) .EQ. 360)IDIR(I) = 0 
IFdALTd) .GT. 1 0000 )G0 TO 34 
29 CONTINUE 

HUM IS THE NUMBER OF DATA POINTS 
34 HUM =1-1 

INCREMENT THE COUNTER -- IF THIS IS THE SET OF DATA DESIRED, 
WRITE OUT THE SOUND ING/FORECAST TIME -- OTHERWISE GET THE NEXT 
SET 

IGOT = IGOT + 1 
I Fd GOT . LT . I WANT )G0 TO 4 

WRITE OUT THE SO UN D I N G7 F OREC A ST TIME 

WRITE (6,20 00) I S T I N , I FL AG ( 4 ) , L A UN TD ( 4 ) , I S D A Y , I SM ON ( 1 ) , I S MO N( 2 ), 

I SYEAR 

THERE MUST BE 5 OR MORE DATA POINTS FOR THIS TO BE A VALID SET 
OF DATA -- IF THERE IS NOT, RETURN WITH IE0F=2 

IF(NUM GE. 5) RE TURN 

lEOF = 2 

RETURN 

END OF KSC65 


END 

SUBROUTINE R WD I S ( NA NE , J J > 

COMMON ALT( 31 ) , ALl, CONMAX, CONCPK,DEGRAD , AD IR , DOSPK, El, CLDHT , 

IDIR(31),I0PT(3),ITIME,IDAY,M0NTH(2),IYEAR,ISTIM,ISDAY, 


A-82 



ooo ooo ooo oooooooo 


lS(10H<2),ISYEftR,IV2,JTOP/JBOT,LAUNTD(10),LTlHE,LTII1,LDAY, 

LH0N<2).LYEftR.LU,NUI1,PI,PI0VR2.PI43,PRESS(31),PTEMP<31). 

SI GHCL, RADDEG/ RATOHC , CLDRAD I R2 , R3. SAVEAt 30 ), SAVERt 30 S IGft. 
SIGX0.SIGX<SPEED<3i>>SQR2PI.SURDEH,SIGZ0.SIGAPiS8.TEHP<31). 
TOPSUR. TWOPI , ASPD , VPARC 1 8 ), CRTIHE< 3 1 ) . D I ST , YES, Y1 . NUMRUN. 
YPOS, IFLAG<5 ),ZB,2Z,REFLEC, IRETRN 
LOGICAL LTIME 
INTEGER YES 

EQUIVALENCE ( QCl , VPAR( 1 > ), < QC2, VPAR< 2 ) ) , < QC3 , VPAR< 3 ) ), 

(QTl / VPAR< 4) >, < QT2, VPAR( 5 >),( QT3, VPAR<6 ) >, 

<AA, VPAR< 7 )),< BB, VPAR< 8) CC, VPAR< 9 j ), 

(HEATH, VPAR< 10 ) ), <HEATM, VPAR< 1 1 ) ), < HEATA , VPARC 12 ) ) , 
<PHCL,VPAR<13)),<PC0,VPAR<14)),(PC02,VPAR(15)>, 
<PAL203,VPAR<16)),<PNO,VPAR<17>>,<GAMMAX,VPAR(18)) 
INTEGER 0DCB< 144 ),0BUF<669 ) 

DIMENSION HAME(3> 

EQUIVALENCE ( 0 BU F ( 1 > , A L T ( 1 ) ) 

CALL 0PEN(0DCB, IERR,HAME,0 ) 

IF<JJ,EQ,1)CALL URITF(0DCB,IERR,0BUF,S69) 

IF(JJ.EQ.O)CALL READF(ODCB, IERR,0BUF,669) 

CALL CLOSEC ODCB, I ERR ) 

RETURN 

END 

SUBROUTINE GETTD(ITI«E,IDAY,MONTH,IYEAR) 


THIS SUBROUTINE RETURNS THE CURRENT TIME, DAY, MONTH, AND YEAR 


TYPE AND DIMENSION STATEMENTS 
INTEGER DAYM0N(12> 

DIMENSION M0NTH(2),H0NTHS(2,12), IT<5) 

DATA STATEMENTS 

DATA H0NTHS/2HJA,1HH,2HFE,1HB,2HMA,1HR,2HAP,1HR, 
2HMA,1HY,2HJU,1HN.2HJU,1HL,2HAU,1HG, 
2HSE,1HP,2H0C,1HT,2HN0,1HV,2HDE,1HC/ 

DATA DA YM ON 731,28,31,30, 31, 30, 31, 31, 30, 31, 30, 31/ 

CALL EXEC TO RETURN CURRENT TIME, JULIAN DAY, AND YEAR 

CALL EXEC< 1 1 , IT, lYEAR > 

USE JUST HOURS AND MINUTES FOR THE TIME 
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ITIME 


100 * IT<4) + IT<3) 


HAKE APPROPRIATE ADJUSTHEHTS IF THIS IS A LEAP YEAR 

DAYH0N(2) *=28 
I = IYEAR/4 

IF(4*I .EQ. lYEAR )DAYM0H<2 ) = 29 

CONVERT THE JULIAN DAY INTO A HONTH AND A DAY 

IDAY = IT<5) 

D 0 7 I = 1 . 1 2 

IDAY = IDAY - DAYM0N< I ) 

1F< IDAY . LE . 0 )G0 TO 12 
7 CONTINUE 

12 IDAY = IDAY + DAYMONC I ) 

HONTH< 1 ) = MONTHS< 1 , I > 

HONTH< 2 ) = M0NTHS<2.I ) 

RETURN TO THE CALLING PROGRAH 

RETURN 

END OF GETTD 

END 

SUBROUTINE B2Z(IA.IB) 

IB = IAND< lA, 177400B) 

IF<IB .EQ. 020000B)IB = 030000B 
IC = IAND(IA,000377B) 

IFUC .EQ. 000040B)IC = 000060B 
IB = IOR< IB. IC ) 

RETURN 
END 

SUBROUTINE DREAO<NAMEF,LNUM.ILINE) 

DIMENSION HAMEFC 3 IOCB( 276 IBUF( 40 ) , ILINEC 32 ) , IPAR( 5 ) 
CALL RHPAR< I PAR ) 

LU = I PAR< I ) 

CALL 0PEN< IDCB , I ERR ,NAMEF, 0 ) 

LOOP = LNUM - 1 
DO 10 1=1, LOOP 
CALL BLANK< I BUF, 40 ) 

CALL READF( IDCB, lERR, IBUF) 

10 CONTINUE 

CALL BLANK< I BUF, 40 > 

CALL READF( IDCB, lERR, IBUF) 

CALL CODE 

READ< I BUF , 1 00 ) ( I L.I NE < 1 ) , I = 1 , 32 ) 

100 F0RMATC32A2> 

CALL CLOSEC IDCB, IERR> 
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RETURN 

END 

SUBROUTINE BLAHKC IBUF . 1 1 > 

DIMENSION IBUF<40) 

DftTft IBLK/2H / 

DO 10 1=1,11 
10 IBUFC I > = IBLK 
RETURN 
END 

SUBROUTINE LERS<YPOS) 

DIMENSION IERS<32> 

DATA IERS/32*2H / 

IF< YPOS .LE. 48) YPOS = 458.0 
CALL CHAR<0 . , YP0S,0, lERS, 64 ,0 , 0 ) 

CALL CHAR<0.,YP0S-16.,0,IERS,64,0,0) 

RETURN 

END 

EHD$ 
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PROGRAM RCLDR 
C 

CLOUD RISE PROGRAM -- A PROGRAM IN THE REED SERIES OF 
PROGRAMS 

k **♦:>(:♦*+•'('** + **+.*****«<* + **+*++. *+m+* -I: ♦tHt***>)i!|i**:* ♦♦*^ti|t**>t!****+. *i***it!*** 


COMMOH BLOCK 

COMMON ALT(31). ALl.CONMAX. CO NCPK, DEGRAD. . ADIR.DOSPK. El. CLDHT, 

IDIR(31).I0PT<3.>.ITIME.IDAY,M0NTH(2).IYEAR,ISTIM.ISDAV. 
ISH0N<2>.ISYEAR.IV2.JT0P.JB0T.LAUHTD(10>.LTIME.LTIM.LDAY. 
LM0H(2).LYEAR.LU.HUM.PI.PI0VR2,PI43.PRESS<31).PTEMP(31). 
SIGHCL.RADDEG.RAT0MC;CLDRAD.R2.R3.SA'/EA(30).SAVER<36),SIGA. 
SIGX0,SIGX,SPEED(31).SQR2PI.SURDEN/SIG20,SIGAP,38.TEMP<31). 
T0PSUR.TW0PI.ASPD.VPAR(18).CRTIHE<31).DIST,YES.Y1.NUMRUN. 
VP0S.IFLAG<5).ZB.2Z,REFLEC.IRETRN 
LOGICAL LTIME 
INTEGER YES 

EQUIVALENCE <QC1.VPAR(1)).<QC2.VPAR<2)).CQC3.VPAR<3)), 
(QT1.VPAR<4)).<QT2.VPAR<5>).<QT3.VPAR<6)>. 

< AA, VPARC 7 )) ,< ee. VPAR< 8 ) ) ,( CC , VPAR< 9) ), 
(HEATH.VPAR(10)).<;HEATM.VPAR<11)).<HEATA,VPAR<12)). 
<PHCL,VPAR(13>).(PC0,VPAR<14)),(PC02.VPAR(15)>. 
<PAL203.VPAR<16)).CPH0.VPAR<17)).<GAHMAX,VPARU8)> 

INTEGER RMETP(3) 

DIMENSION •lAS(31).HAHE(3),N AM EF( 3). ILINE<32).IDATAF(10). 

I ERS< 80 ). ISURTP( 3 ) 

OUTPUT FORMAT STATEMENTS 
C 

100 FORMAT (F7.2> 

101 FORMAT (12) 

102 F0RMAT<F3.1) 

200 FORMAT ( " 1 “ 2 7X “ E X HA US T C LO U D " / " 0 LE V E L " 4 X " A LT I T U DE " 1 7 X 

"RISE TIME"5X"RANGE"6X"DIRECTION.'‘/10X"( METERS)"17X 
"< SECONDS >" 4X "< METERS )" 4X" ( DEGREES >" ) 

201 FORMAT C 2 X I 3 . 5 XF 7 . 1 . 5 X " A D I A B A T I C " 5 XF 6 . 1 . 6 X F 7 . 1 , 7X F5 . 1 ) 

202 FORMAT < 2 X I 3 , 5 XF 7 . 1 . 6 X " S T A B LE " 7 X F8 . 1 . 6X F 7 . 1 . 7X F 5 . 1 ) 

203 FORMAT ( / / » 0 ** ** C LO UD ST AB L I Z AT I ON * * * * " X 

6X"HEIGHT(M )! “F6. IX 

6X"STABI L IZAT I ON TIME AFTER LAUNCH(SEC)! “F5.1X 

6 X“RANGE FROM PAD(M)! "F7.1X 

6X" D IRECT ION FROM PAD (DEG): "F5.1> 

204 FORMAT < F8 . 1 ) 
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205 FORMAT < / / >• 0 ** *♦ T OP OF SURFACE LAYER METEOROLOGICAL PARAMETERS" 

" + 4: * i»! “ / 

6X“HEIGHT(M )! “F6.1/ 

6>!"«IND DIRECTION< DEG >! "13/ 

6X“UIND SPEEDC M/SEC ): "F4.1> 

206 FORMAT < //“ 0>t>***0 IFFUS ION P AR AM E TE RS + ** * “ / 

6X"t1EAN SPEEO( M/SEC ): “F4.1/ 

6X‘‘MEAN TRANSPORT D I R EC T I 0 N< D EG ) i "F5.I> 

207 FORMAT (F3.0) 

208 FORMAT <//"OSIGMA OF WIND AZIMUTH ANGLE. SICAi “F4.1) 

209 FORMAT < / / ” 0 EF FE C T I VE CLOUD HEIGHT(M)! "F6.1) 

TYPE AND DIMENSION STATEMENTS 
INTEGER RC0NC<3) 

DATA STATEMENT 

DATA NAME/036522B,2HEE.1HD/,NAMEF/2H?R.2HCL/2HDR/ 

DATA RMETP/2HRM. 2HET. 1 HP/ 

DATA RC0NC/2HRC. 2H0H. IHC/ 

DO 1 1=1.80 
1 IERS< I ) = 2H 
C 

C K* CALL GRAF(l) TO INITIALIZE PLASMASCOPE GRAPHIC MODE 
CALL GRAFC 1 ) 

C ** INITRIALI2E THE Y POSITION OF THE CALL CHARACTER STATEMENTS 
C ON THE PLASMASCOPE. 

C YP0S=490. 

C *** READ COMMON DATA FILE I-** 

CALL RWDI S< NAME. 0 ) 

C 

C INITIALIZE SOME LOCAL VARIABLES 

C 

C CRTIME< ) - CLOUD RISE TIME 

C IAS< ) - 0 = ADIABATIC 

C 1 = STABLE 

C ALTINC - ALTITUDE INCREMENT 

C ITERAT - ITERATION COUNTER 

C 

RNGY = 0.0 
RNGX = 0.0 
CRTIMEt 1 ) = 0.0 
ALTINC = 0 . 0 
SAVERC 1 > = 0.0 
SAVEA< 1 > = 0.0 
ITERAT = 0 
C 

C URITE OUT THE EXHAUST CLOUD HEADER 

C 
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WRITE <6,200) 


CALCULATE SOME QUANTITIES TO BE USED IN SUBSEQUENT DO LOOP 

ALPHAC = 5. 12913086E-02*<TEMP< I ) + 2 7 3 . 1 5 ) *S UR D EN f C A MM AX* *3 
ALPHAC = ALPHAC/< HEATH * QCl) 

GT = 9.8/<TEMP<l) + 273.15) 

DO LOOP TO CALCULATE EXHAUST CLOUD PARAMETERS 

DO 9 1=2, HUM 

IMl =1-1 
I AS< I ) = 1 

CALCULATE SLOPE OF POTENTIAL TEMPERATURE, SPEED, AND 
DIRECTION IN LAYER 

DALT = ALT< I ) - ALT< IMl > 

GPTEMP = <PTEMP(I) - P TE MP < I M 1 > ) /D AL T 
GSPEED = <SPEED(I) - S PE ED ( I M 1) ) / D AL T 
GDIR = FL0AT< IDIR< I ) - I D 1 R < I M 1 ) ) / D A L T 

CALCULATE METEOROLOGICAL AND ENERGY FACTOR 

2 Z = ALT< I ) - ALT< 1 ) - ALTINC 

ALPHA = ALPHAC * Z**4/<AA * Z**BB + CO 

CALCULATE POTENTIAL TEMPERATURE FACTOR 

STAB = GT ♦ (PTEMPCI) - ALTINC * GPTEMP - PTEMP<1>)/ 

<ALT<I) - ALTINC - ALT(l) + l.OE-7) 

CALCULATION FOR ADIABATIC RISE 

IF<STAB .GT. 0.000001)GO TO 4 
CRTIME< I ) = SQRTC ALPHA ) 

I AS< I ) = 0 
GO TO 6 

CALCULATION FOR STABLE CLOUD RISE 

C2 - ARGUMENT OF ARC COSINE (MUST BE LESS THAN -1) 

4 C2 = I.O - 0.5 * ALPHA * STAB 
IF<C2 . LT . -1 . 0)G0 TO 5 
C3 = C2/SQRT< 1.0 - C2 * C2 ) 

CRTI ME< 1+ HERAT ) = (PI0VR2 - A T A N < C3 ) )/ SQ R T< S T A B ) 

IF< I TERAT . EQ . 1 )G0 TO 11 
GO TO 6 
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ITERATE IN LAYER 


5 ALTINC = ALTINC * S.O 
ITERAT » 1 
GO TO 2 

CALCULATE RANGE AND DIRECTION 

€ DELRNG > - 0.5 * (SPEED(IHl) * SPEED(I>> * 

<CRTINE<IN1) - CRTIHE(I)) 

OELDIR => 0.00872665 * FL OA T < I 0 1 R ( I > * IDIRCIH1>> 

RHGY s RHGY - DELRNG SIH(DELDIR) 

RNGX » RNGX - DELRNG * COS(DELDIR) 

AZHUTH = RADDEG * ATAN2( RNG Y. RNGX > 

IFCAZHUTH .LT. O.O^AZNUTH = AZMUTH + 360.0 
DELRNG = SQRT<RHGY * RNGY + RNGX * RNGX) 

SAVER( 1 > = DELRNG 
SAVEA< I ) = AZNUTH 

WRITE OUT THE VARIABLES WITH THE APPROPRIATE FORMAT STATEMENT 
BASED OF WHETHER OR NOT CLOUD IS ADIABATIC OR STABLE 

IF( IAS( I ) . NE. 0 )G0 TO 8 

WRITE (6,201) I, ALTd ),CRTIME(I ), DELRNG, AZMUTH 
GO TO 9 

8 WRITE ( 6,202 ) I , ALTC I ) , CRT I ME( I ) , DELRNG , AZMUTH 

9 CONTINUE 

CALCULATE AND WRITE OUT STABILIZATION HEIGHT AND TIME 

11 DELRNG = 0.5 * (SPEED(IMl) - ALTINC * GSPEED + SPEED(I)) * 
(CRTIME(I + 1) - CRTIME(IMl)) 

DALT = 0.00872665 * ( FLO AT< ID IRC I ) + IDIR(IMD) - GDIR • ALTINC) 
RNGY - RNGY - DELRNG * SIN(DALT) 

RNGX = RNGX - DELRNG * COSCDALT) 

AZNUTH = RADDEG ♦ ATAN2C RNGY, RNGX > 

IF(AZMUTH .LT. 0.0)AZMUTH = AZMUTH + 360.0 
DELRNG = SQRTCRNGY * RNGY + RNGX * RNGX) 

ALT( 31 ) = ALT( I ) - ALTINC 

WRITE ( 6, 203 ) AL T ( 3 1 ) , CR T I M EC 1+ 1 ) , DE L RN G , A ZM UT H 

STORE THE INDEX OF THE ESTIMATED TOP OF THE SURFACE LAYER 
JTOP = I 

LOAD THE CLOUD RISE TIME ARRAY 

CRTIME(31) = CRTIMECJTOP) 

DO 15 J=I ,NUM 
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15 CRTIME<I) » CRTINE<31) 

IS THIS A RESEARCH OR A PRODUCTIOH RUN? 

IF<I0PT<2) -HE. 0)G0 TO 21 

PRODUCTIOH RUH -- IF TOPSUR IS UNDEFINED< USE JTOP AS ESTIMATED 

17 IF<TOPSUR .LE. 0.0)C0 TO 26 

CALCULATE JTOP BASED OH VALUE OF TOPSUR 

LEASTD = 9999999.9 
DO 19 1=1 /MUM 

DIFF = ABS<ALT<I) - TOPSUR) 

IF<DIFF .GT. LEASTD)G0 TO 19 
LEASTD = DIFF 
JTOP = I 
19 CONTINUE 
GO TO 26 

URITE OUT THE ESTIMATED TOP !OF SURFACE LAYER -- READ IN 
THE ONE TO BE USED -- CALCULATE JTOP 

21 CALL DREA'DC HAHEF. 2/ ILINE > : , 

CALL LERS<YP0S) 

CALL CHAR<0. /YPOS/O/ILINE/64/0/0) 

CALL CODE 

WRITE <rSURTP,204) ALT<JTOP) 

TOPSUR = ALT< J TOP > 

CALL CHAR<320. /YPOS/0/ ISURTP/6/ 0,0 ) 

YPOS = YPOS - 32. 

IF< IFLAG< 1 ) .EQ. 3)G0 TO 26 
IFdFLAGCl) .EQ. DGO TO 24 
CALL DREADC NAMEF, 3, ILINE > 

CALL LERS(YPOS) 

CALL CHAR<0.,YP0S,0,ILINE,6,3,O) 

CALL CHAR<56 ./ YPOS, 0, lERS, 1 , 3,0 ) 

CALL CHAR<64 . , YPOS, 0, ILINEC 5),9, 3, 0) 

CALL CHAR<160.,YPOS,0,ILINE<11),44,0,0) 

NIN=6 ) 

CALL 6LANK< IDATAF, 10) 

CALL IN(2,JTYPE,463.,YPOS,0,IDATAF,HIH,0,31,0,31,IX,IY) 

IF<JTYPE .EQ. DGO TO 22 

CALL CHAR<0. , YPOS, 0, ILINE, 6, 0,0) 

CALL CHARC47.,YPOS,0,IERS,40,0,0) 

YP0S=YP0S-32 . 

CALL CODE 

READ < IDATAF , 100 ) TOPSUR 
ALT<JTOP) = TOPSUR 
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GO TO 17 

22 IF(IX .GT. 9)G0 TO 23 

CALL CHAR<0. i VPOS iO.il IHE, 18, 0.0) 

CALL CHAR(143. .YPOS.O. lERS. 46.0.0) 

YPOS » YPOS - 32. 

GO TO 17 

23 CALL CHAR<0. .YPOS.O.ILINE.6.0.0) 

CALL CHAR(S6 . . YPOS. 0. lERS. 10. 0. 0 ) 

CALL CHAR(360..YP0S.0. lERS. 18.0.0) 

YPOS » YPOS - 32. 

CALL HET PROFILE. SUBROUTINE. RHETP . TO DETERNIHE LAYER VALUE 

24 CALL HGRAF 

CALL RUDIS( NAME. 1 ) 

CALL EXEC<9.RHETP) 

CALL RUDIS< NAHE. 0 ) 

CALL GRAF( 1 ) 

CALL CLEAR 
YPOS = 474. 

CALL OREADC NAHEF. 5. ILINE > 

CALL LERS(YPOS) 

CALL CHARXO . . YPOS.O . IL INE. 50. 0. 0 ) 

CALL CODE 

URITE (lOATAF.lOO) TOPSUR 

CALL CHAR<400 . . YPOS . 0 . IDATAF. 7. 0 . 0 ) 

ALT(JTOP) ■ TOPSUR 
YPOS = YPOS - 32. 

GO TO 17 

MRITE OUT THE TOP OF THE SURFACE LAYER AND UIND DIRECTION 
AND SPEED AT THE TOP 

26 CONTINUE 

UR ITE . ( 6. 205 ) TOPSUR. IDIR( JTOP ). SPEED( JTOP ) 

CALCULATE SOURCE STRENGTH 

SIGHCL = 2.276E3 ♦ PHCL ♦ QCl k AA * <TEHP<1) + 273.15)/ 

PRESSC 1 ) * TOPSUR**BB 

CALCULATE AND URITE OUT THE MEAN UIND SPEED. ASPD. AND 
DIRECTION. ADIR 

DO 28 1=2. JTOP 

IF<IABS<IDIR<D - IDIR<I - D) .LT. 180)G0 TO 28 
DO 27 J=1.JT0P 

27 IF<IDIR<J) .LT. 180)IDIR<J) = IDIR<J) + 360 
GO TO 31 

28 CONTINUE 
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c 

31 ASPD = 0.0 
ADIR = 0.0 

DO 32 I=2,JT0P 
Iffl = 1 - 1 

DALT = ALT< I > - ALT< IMl) 

ASPO = ASPD + 0.5 * (SPEEDtn + SPEED<IM1)> * DALT 

32 ADIR = ADIR + 0.5 * F L 0 A T< I D I R< I ) + IDIR<IM1>) * DALT 
C 

DO 34 I=1.JT0P 

34 IF<IDIR<I) .GT. 360>IDIR<I) = IDIR<I> - 360 
C 

DALT = ALT< J TOP ) - ALT< 1 ) 

ASPD = ASPD/DALT 

ADIR = ADIR/DALT 

IF<ADIR .GT. 180.0)G0 TO 35 

ADIR = ADIR + 180.0 

GO TO 36 

35 ADIR = ADIR - 180 .0 
C 

36 URITE <6.206) ASPD.ADIR 
IS THIS A RESEARCH OR A PRODUCTION RUN? 

IF<I0PT<2) .EQ. 0)G0 TO 45 

RESEARCH RUN -- READ IN SIGA 


C** CALL SUBROUTINE RSIGA TO CALCULATE SIGMA VALUE 
C 

J 1 = 1 
J2 = 0 
J3 = 0 

DO 41 JJ=1.31 

IF< ABS< ALTC J J )-304 . 8 ) . LE . 1 . 0 ) J3 = JJ 
IF< ABS< PRESS< J J )- 1000 . >. LE . 1 . 0 ) J2 = JJ 

41 CONTINUE 

IF<J2.EQ.O .0R.J3.EQ.0) SIGA = 7.0 
IF<J2.E8.0 .0R.J3.EQ.0) GO TO 42 
CALL RSIGAC Jl. J2. J3.RSIG) 

SICA = RSIG 

42 CALL DREAD< NAMEF . 6. ILINE ) 

CALL LERS(YPOS) 

CALL CHAR<0. ,YP0S,0,ILINE.64,0,0) 

CALL CODE 

URITE< IDATAF. 102 ) SIGA 
CALL CHAR<330..YP0S,0,IDATAF,4,0,0> 
CALLIN<2.JTYPE.0.,0.. 0.0, 0,0, 31, 0.31, IX. IV) 
YPOS = YPOS - 32.0 
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I F< I X . LE . 25 ) GO TO 45 
CALL DREAD< NAHEF. 7. ILINE) 

CALL LERS(YPOS) 

CALL CHAR<0..YP0S,0.ILIHE.62>0,0) 

NIN = 2 

CALL BLANK< IDATAF , 1 0 ) 

CALL IH<:O.JTYPE.3 58.0,YP0S,0,IDATAF.NIN,0i31.0,31.IX,IY) 

CALL CODE 

READ ( IDATAF, 101 ) ISIGA 
IF<HIN .EQ. DISIGA = ISIGA710 
SIGA = FLOATdSIGA) 

YPOS = YPOS - 32. 

C URITE OUT SIGA> THE SIGMA OF THE UIHD AZIMUTH ANGLE 

C 

45 WRITE < 6. 208 ) SIGA 
C 

SIGAP = 0.0087266 * SIGA 
C 

C CALCULATE THE HORIZONTAL AND VERTICAL CLOUD DIMENSIONS. 

C i . e . S IGXO AND GSPEED 

C 

SIGXO = 0 .297674 * ALT(31> 

GSPEED = 0.232558 * ALT(31) 

C 

C CALCULATE AND WRITE OUT THE EFFECTIVE CLOUD HEIGHT. CLDHT 

C 

CLDHT = ALT< 31 > 

CLDRAO = 2.15 ■» SIGXO 
IV2 = 0 

IF< CLDRAD+ALTC 31 ) . GE . A LT < d T OP ) ) I V 2 = 1 
SIGZO = SIGXO 

IF<IV2 EQ. nSIGZO = <ALT(JTOP) - ALT(31) + CLDRA0)/4.3 
IF<SIGZO .GT . 0. 0 )G0 TO 47 
CLDHT = 0.5 * ALT(JTOP) 

SIGZO = 0.64 * CLDHT/2. 15 
GO TO 49 

47 IF<IV2 .EQ. DCLDHT = 0.5 * (ALT(JTOP> + ALT<31) - CLDRAD) 

C 

49 WRITE <6.209) CLDHT 

CALL THE SEGMENT RCONC 

CALL HGRAF 
CALL RWDISC NAME. 1 > 

CALL EXEC< 9 . RCONC ) 

CALL RWDI S( NAME. 0 ) 

END OF RCLDR 


END 
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SUBROUTINE RUD IS( NfiHE . J J > 

CONN ON RLT( 31)^ ALli CONNAX> CONCP K > D EGR AD ^ A D I R , D OSP K . E 1 < CLOHT . 

IDIRt 31 IOPT< 3 >, ITIHE, IDAY,HONTH< 2 lYEAR, ISTIM, ISDAY, 
ISnON<2)i ISYEAR. IV2> JTOP, JBOTi LAUHTD( 10 ).LTINE, LTIH.LDAY, 
LHOH< 2 ) < LYEAR. LU. NUN .PI, P I0VR2 .P 143 i PRESS( 31 ) ,PTEHP( 31 
SIGH CL. RADDEG. RAT0MC.CLDRAD.R2.R3. SAVEA( 30 ). S AVER< 30 ). S IG A. 
SIGX0.SIGX.SPEED<31).SQR2PI.SURDEH.SIGZ0.SIGAP.S8.TEHP(31>. 
TOPSUR. TU OPl. ASPD. VP AR(18>.CRT1HE< 31 >. DIST.YES.Y1 .hu NR UN. 
YPOS. IFLAG<5 l.ZB.ZZ.REFLEC. IRETRN 
LOGICAL LTIME 
INTEGER YES 

EQUIVALENCE ( QCl . VP AR< 1 ) ). < QC2. VPAR< 2 ) ) . < QC3 . VP AR< 3 ) ). 

<QT1 . VPAR( 4 ) ). < QT2. VPAR( 5 > ) , ( QT3 , VPAR< 6 > ). 

< AA. VPAR< 7 )).< BB. VPAR< 8 > ) , ( CC , VPAR< 9 ) ). 

< HEATH. VPAR( 10 ) >. ( HEATH. VPAR( 1 1 > >. < HEATA > VPAR< 12) ) . 
<PHCL.VPAR<13)>.(PC0.VPAR(14)>.(PC02.VPAR(15)). 

(PAL203 . VPAR< 16 ) ). ( PNO , VPARC 1 7 ) ) . ( GAHMAX . VPAR( 1 8) ) 
INTEGER 0DCB( 1 44 ) .08UF< 669 ) 

DIHENSIOH NANE<3) 

EQUIVALENCE < OBUF( 1 ). ALT< 1 ) ) 

CALL OPEN<ODCB. lERR.NAHE.O ) 

IF( J J . EQ. 1 )CALL URITFC OOCB. lERR. 08UF. 66 9) 

IF<JJ.EQ.O>CALL R EADF < OD CB . lERR . 08UF , 66 9 ) 

CALL CL0SE<0DCB. lERR) 

RETURN 

END 

SUBROUTINE OREAO< NANEF . LNUH . ILINE ) 

DIMENSION NAMEF(3).IDCB< 276).IBUF<40),ILINE(32>.IPAR(5) 

CALL RMPAR< I PAR ) 

LU = IPARO ) 

CALL OPEN<IDCB.IERR,NAMEF.O) 

LOOP = LNUH - 1 
DO 10 1=1, LOOP 
CALL BLANKC IBUF. 40) 

CALL REAOFC IDCB. lERR. IBUF) 

10 CONTINUE 

CALL BLANKC IBUF. 40) 

CALL READFC IDCB. lERR. IBUF) 

CALL CODE 

READ (IBUF. 100) < IL INE< I ). 1 = 1 . 32 ) 

100 F0RHAT(32A2) 

CALL CLOSE< IDCB. lERR ) 

RETURN 

END 

SUBROUTINE BLANK( IBUF . 1 1 ) 

DIMENSION IBUF<40) 

DATA IBLK/2H / 

DO 10 1=1.11 
10 IBUF< I ) = IBLK 
RETURN 
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END 

SUBROUTINE LERS< YPOS) 

DIMENSION IERS<32) 

DATA IERS/32+2H / 

IF(YPOS.LE. 48) YPOS =458.0; 

CALL CHARtO . i YPOS ,0 /IERS.64.0‘i0 ) 

CALL CHAR.CO . .YPOS-18. .OSIERS. 64,0/ 0) 

RETURN 

END : ; 

SUBROUTINE R S I GA < J 1 , J 2 , J 3, R S I G > 

C 

C*** THIS SUBROUTINE CALCULATES A SIGMA VALUE GIVEN 
C*** ALTITUDE! SPEED, TEMP, AND PRESSURE FOR THE 
C*f* FIRST LEVEL OF DATA, THE lOOOFT LEVEL OF DATA 
Cf** AND THE 1000MB LEVEL OF. DATA 
C ■ 

C 

C+* COMMON BLOCK 

C 

COMMON ALT<31),AL1, CON M AX, COHCPK, DEGRAD, ADIR,DOSPK, El, CLDHT, 

IDIR<31),I0PT<3),ITIME,IDAY,M0NTH(2),IYEAR,rSTIM,ISDAY, 
ISM0N<2),ISYEAR,IV2,JT0P,JB0T,LAUHTD(10),LTIME,LTIM,LDAY, 
LM0N< 2 ) ,LYEAR, LU, NUM,P1, P I0VR2 , P143 , PRESS! 31 ) , PTEMP< 31 ) , 
SIGHCL,RADDEG,RAT0MC,CLDRAD,R?,R3,SAVEA(30),SAVER(30),SIGA, 
SIGX0,SIGX.SPEED(31),SQR2PI,SURDEN,SIG20,SIGAP,S8,TEMP<31>, 
TOPSUR, TWOPI , ASPD, VPAR< 18 ), CRT IME( 31 ),D 1ST, YES, Y1 , NUMRUN, 
YPOS , IFLAG! 5 >, ZB, ZZ, REFLEC, IRETRN 
LOGICAL LTIME 
INTEGER YES 
C 

DATA C 1 , C2, C3, C4 , C5 ,C6/- . 008, 001 75 ,. 0008 50864522 ,. 11 32, 

1 3.81637 

DATA C77.029/ 

C CALCULATION OF SIGAR 

C NEWTONS METHOD FOR SOLUTION OF F<X,B,D> = 0 

F<X,B,D) =< 1 . -X*f4 )7< 1 6 . i-X + ^Z*! ALOG( D )+C4-2 . *ALOG< 1 . +X > 

1 - ALOG< 1 . +X**2 ) + 2. *ATAH<X ) >**2 ) - B 
FP<X,D) =<-X**4-l. )/(8.*X**3*!AL0G(D) + C4-2.>i'AL0G<l.+X> 

1 - ALOGd .+X**2) + 2.*ATAN<X))**2) + < 1 . -X**4 )/( 2 . *< 1 . +X ) 

1 *<l.+X**2)*<AL0G<D)+C'4-2. *ALOG( 1 . +X ) - A LO G < 1 . + X * * 2 ) + 

1 2 ■ *ATAN< X) )**3) 

C 

C*** READ 1ST DATA LEVEL 
C 

Z1 = ALT! J1 ) 

VI = SPEED!J1) 

T1 = TEMP! J 1 ) 

PZl = PRESS! J1 ) 

C 

C*** READ 1000MB DATA LEVEL 
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Z2 = ALT< J2 ) 

V2 = SPEED<J2) 

T2 = TEI1P<J2) 

PZ2 = PRESS<J2) 

C 

C*** READ lOOOFT DATA LEVEL 
C 

23 = ALT(.J3> 

V3 = SPEED< J 3 > 

T3 = TEI1P<J3) 

P23 = PRESS<J3> 

C 

+•■*= CONVERT TO PROPER UNITS 

VI = VI*. 514791 
V2 = V2*. 514791 
V3 = V 3*. 514791 

21 = 21*. 3048 

22 = 22*. 3048 

23 = 23* . 3048 
T 1 = T 1 +273 . 16 
T2 = T2 + 273 . 16 
T3 = T3+273 . 16 

C 

C*** INITIALIZE 20 
C 

20 = .20 

C PZi AND PZ3 IN MILLIBARS 
C VI, V2 AND V3 IN METER/SEC 
C 21,22 AND 23 IN METERS 
C Tl, T2 AND T3 IN DEG K 
C 20 IN METERS 

E = 22.9183118 
V = V2 

T=<Tl+T2+T3)/3. 

2 = < 2 1*22*23 )**. 33333 

THETAl = Tl *<< 1000 . /P2 1 )**. 288 ) 

THETA2 = T2 

THETA3 = T3*<< 1000. /P23)** . 288) 

ZA = ( 21 + 22 + 23 >73 . 

THETAA = <THETA1 + THETA2 + THETA3)/3. 

D = Zf'ZO 
ZOZO = ALOG(D) 

D2THET = C< 21-ZA )*< THETAl-THETAA )+C22-ZA)*<THETA2-THETAA > 

1 +< Z3-ZA )*( THETA3-THETAA ) )/< C 21 -ZA >**2 + (Z2-ZA)**2 

1 +(Z3-2A)**2) 

B = 9 . 8*DZTHET*Z**2/< T*V**2 > 

IFCB > 2,25,6 
2 CONTINUE 
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R » 1 . 5 
U « F(R,B.O > 

DO 3 I « 1/50 

R1 « R - F(R.B;D>/FP(R/D> 

U«F(R1.B/D> 

IF<ftBS(Rl-R).LT. 1 .E-?) GO TO 21 
XFCI .E0 .49) USAV » U 
IF<I .HE. 50) GO TO 888 

IFCUSAV.LT.O. .AHD.U.GT.O. .OR.USAV.GT.O. .AND.U.LT.O. } GO TO 21 
888 COHTIHUE 
3 R > R1 

RSIG « 30. 

GO TO 1000 
6 AP » 20Z0 - 1 . 

Z00L10*<C6*Z0)/< 7 .*Z) 

A1 s 1 . 

A2 * 1 ./<SQRT<B) • 7.*AP) 

A3 * -< AP ♦ 1 . >/< 7 . *AP ) 

RAD » A2**2 - 4.*A1>»A3 
IF(RAD) 70/80,90 
70 CONTINUE 

RSIG = 30. 

GO TO 1000 

80 REll = -A2/<2.*A1 ) 

SI = 1. - 7.*RE11**2 
GO TO 26 

90 REl = <-A2 + SQRTCRAO ) )/<2 . *A1 ) 

RI4 = RE1**2 

Z00L4 = Z0*R14/< Z*( 1 . -7.*RI4)> 

IF<B .LT .C3) GO TO 37 
IF<8 .GE C3) GO TO 38 

21 RIl * < 1 . -Rl**4)/16 . 

ZOOLl = Z0*RI1/Z 

A » ZOZO +C4-2 . *ALOG< 1 . +R1 )-ALOG< 1 . + R 1**2 )+2 . ♦ ATAN< Rl) 

IF<8 . LT . Cl ) GO TO 22 

IF(B .GE .Cl . AND .8 . LT .C2 > GO TO 23 

IF(B.GE.C2) GO TO 24 

22 RSIG = E*2 . 7/8 
GO TO 1000 

23 FB2 = 2.7 + 112.*<-C1 + B) 

RSIG = E*FB2/A 

GO TO 1000 

24 FB3 =3.4 - 725.5*<-C2 +B) 

RSIG = E*FB3/A 

GO TO 1000 

25 RI2 = 0 
Z00L2 = 0 

RSIG = 48.8167AL0G(D> 

GO TO 1000 

26 RI3 = < Sl-1 . >/'<-7 . ) 
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Z00L3 = Z0*RI3/<Z*( 1. -7.*RI3)> 

IF(B.LT.C3) GO TO 27 
1F(B.CE.C3> 60 TO 28 

27 FB3 » 3.4 725.5*<-C2 + B) 

RSIG * <E*FB3)/< 7.#RI3/'< 1. -7.*RI3) + ZOZO ) 
SIGR20s(E*FB3>/( C8-»^Z0Z0 > 

IFCRI3 . GE .C5 > GO TO 110 
GO TO 1000 
110 CONTINUE 

RSIG = SIGR20 
GO TO 1000 

28 F84 = 1.55 + 38.04*<B - .0008) 

RSIG = <E*F84)/( 7.*R13/< 1. -7.*R13) + 2020 ) 
SIGR21»<E*FB4)/< C6+Z020 ) 

IF<RI3 . GE .C5 ) CO TO 1 15 
GO TO 1000 
115 CONTINUE 

RSIG » SIGR21 
GO TO 1000 

37 FB3 * 3.4 - 725 . 5*( -C2+B ) 

RSIG = <E*FB3)/< 7.+RI4/U. - 7.*RI4 ) + 2020 ) 
SIGR20=«(E*FB3)/CC6+Z0Z0) 

IF<RI4 . GE .C5 ) GO TO 120 
GO TO 1000 
120 CONTINUE 

RSIG = SIGR20 
GO TO 1000 

38 FB4 = 1.55 + 38.04*<B - .0008) 

FB5 = 2.35 + 5.43*<B - C7) 

RSIG = <E*FB4)/< 7.*RI4/<1. - 7.*RI4) + 2020) 
SIGR21*<E*FB4)/'(C6+Z020) 

SIGR22 = <E*FB5)/(C6+2020) 

IF<RI4 . GE . C5 . AND . B. LT . C7 ) GO TO 125 
1FCRI4 . GE . C5 . AND . B. GE . C7 ) GO TO 126 
GO TO 1000 

125 CONTINUE 
RSIG = SIGR21 
GO TO 1000 

126 CONTINUE 
RSIG = SIGR22 
GO TO 1000 

C 

C*** CHECK FOR VALID S I GA VALUE 
C 

1000 CONTINUE 

IF (RSIG.LE.O. .OR. RSIG. GT. 30.) RSIG = 30. 

RETURN 

END 

ENDS 
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PROGRAH RHETP 
COHHOH BLOCK 

COHKOH ALKSDiALl/COKHAX.CONCPK.DEGRAD.ADIR^DOSPK/El.CLDHT, 

IDIR< 31 IOPT( 3 ). ITIME, IDAY , «ONTH< 2 >/ lYEAR , ISTIH. ISDAY, 
ISM0H<2)MSYEAR>IV2 jJT 0P,JB0T,LAUNTD(10).LTIHE.LTIM.L0AY, 
LMOH< 2) i LYEAR. LU, HOHi P P I0VR2 ,PI43 ,PRESS( 31 ) , PTEHP< 31 ), 
SIGHCL. RADDEG. RATOHC >CLDRAD .R2 . R3/ SAVEAC 30 >/ SAVER< 30 >, SICA. 
SIGXO .S IGX .SPEED< 31 > .SQR2PI .SURDEH > SIGZO . S IGAP. SB. TEMP< 31 >. 
T0PSUR.TH0PI.ASP0.VPAR(18).CRTrME<31).DrST.V£S.Yl.N0MRUN. 
YPOS . IFLAG< 5 ). ZB. ZZ. REFLEC. IRETRN 
LOGICAL LTIHE 
INTEGER YES 

EQUIVALENCE (QC1.VPAR<1)>.(QC2.VPAR(2>>.(QC3.VPAR(3>>. 

<QT1.VPAR<4)).(QT2.VPAR<5)>,(QT3.VPAR<6)>. 

< AA. VPAR< 7 >).( 8B. VPAR< 8 ) ) ,( CC . VPAR( 9) ). 
<HEATN.VPAR<10)>.(HEATN.VPAR<11)).<HEATA.VPAR(12)). 

( PHCL , VPAR< 13) ) .< PCO , VPAR< 1 4 ) > , ( PC02. VPAR( 15 ) ). 

<PAL203 . VPARC 16 )).< PNO . VPAR< 1 7 > ). ( GAMMAX, VPAR< 18 ) ) 
DIMENSION «SX(31),WSY(31),DTX(31).DTY<31),PTX(31).PTY(31>. 

1 UDX<31 >,UDY(31 ) 

DIMENSION ISTP<3 >. I TTP<3 ). ISPT< 3 ). ITPTC 3). I8US< 3). ITWSC3 ) 
DIMENSION ISUD<3).ITUD<3).XDT1C(2).YDTIC<2>.ICURI<21> 

DIMENSION ITESTC 10).TPR<6). IDCB< 144) 

DIMENSION X<4).Y<4).XTIC1(2).XTIC2<2).YTIC1(2).YTIC2(2) 

DIMENSION XS<2).YS<2).IALTL(8).TSURX(20).BSURX(10) 

DIMENSION IALTCH<336),IALT(22).IHARD(16) 

DIMENSION IXNUH<13).IYHUM<22).IALTC1(8) 

D I MENS I ffN ITEHPD( 3 ) . IPRESD( 3) . IDEHSD< 3 ) 

DIMENSION IDATL( 2 ). ITIML<2 ) 

DIMENSION IDATEC 6 ). AUDIR<31 ) 

DIMENSION ITMME<2) 

DIMENSION APTEMP< 31 ) 

DIMENSION XL<2 ). YLC 2). IDT< 12). IPTC 11 ). IWS< 8). IUD< 10 ) 

DIMENSION ISURLK 30 ). IALTSP<8 ) 

DIMENSION ISURK 22) . ISURTK 16 ). I ALTP( 8 ) . I ALTCL< 8) 

DIMENSION ICRVK 4 ). ISTL< 12 ). ITOP< 2 ). YMDK 2 ). Y«D2< 2). XBDK 18 ) 
DIMENSION IB0T(2) 

DIMENSION XUD2(2 ) . lUDLU 18 ). IU0L2( 18 ) . IUDL3( 18 ) . IUDL4< 18 ) 
DIMENSION ITPV<3 ).HAME<3 ) 

DIMENSION IMET<2 ). IHSTAL<2. 2), ISTAB< 4 ) 

INTEGER RMETQ(3) 

DATA IHARD/2HHA. 2HRD. 2H C.2H0P.2HY . 2HDE. 2HS I . 2HRE. 2ND?. 2H . 

2H .2HYE.2HS .2H .2H .2HN0/ 

DATA RMETQ/2HRM. 2HET. IHQ/ 

DATA HAME7036S22B.2HEE.1HD/ 

DATA IUDL1/2H 0.2H .2H .2H .2H 9.2H0 .2H .2H .2H18.2H0 . 

2H .2H .2H27.2H0 .2H . 2H .2H36.2H0 / 
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DATA IMDL2/2K90, 2H , 2H . 2H .2H18,2H0 .2H ,2H ,2H27.2H0 , 

2H .2H .2H36.2H0 ,2H /2H .2H90,2H / 

DATA iyDL3/2H18, 2H0 .2H ,2H .2H27,2H0 ,2H . 2H ,2H36.2H0 , 

2H .2H .2H90,2H ,2K ,2H .2H18.2H0 / 

DATA I WDL472H27. 2H0 -2H .2H .2H36/2H0 ,2H .2H ,2H90,2H , 

2H .2H /2HI8.2H0 /2H . 2M .2H27.2H0 / 

DATA XWD1730C>. ,300. ,320. ,320. ,340. ,340. ,360. ,360. ,380. ,380. , 

400. ,400. ,420. ,420. ,440. , 4 40. ,460. ,460.7 
DATA I CRVT/2HUS, 2HDT, 2HPT, 2HyD/ 

DATA IEXP372H3 7 

DATA I STL72HSP , 2HEE , 2HD< , 2HM7 , 2HS ) , 2H , 2 H TE , 2 H (IP , 2 H C 0 , 2 H EG , 2 H C, 
12H ) 7 

DATA I CUR 172HT0, 2HUC, 2HH , 2 H Y - , 2 H A X , 2 H I S , 2 H T,2H0 ,2HEN, 

12HTE,2HR ,2HT0,2HP ,2H0F,2H 3 , 2 H UR , 2 H F A , 2 H CE , 2 H L,2HAY,2HER7 
DATA TPR7 139 . , 187 . , 236 . , 285 . , 334 . , 383 . 7 
DATA XDTIC7100 .,106.7 

DATA ITEST72H ,2H ,2H ,2H ,2H ,2H ,2H ,2H ,2H ,2H 7 

DATA I SURLl 72HSU , 2HRF , 2HAC , 2HE ! , 2H 

2H , 2HPR, 2HES, 2HSU, 2HRE, 

2H , 2H , 2H , 2H , 2H M , 

2HB , 2H , 2H , 2H 0,2HEN, 

2HSI,2HTY,2H , 2H , 2H , 

2H ,2H G,2H7«,2H , 2H 7 

DATA IDT72HDR,2HY , 2H T E , 2H II P , 2H E R , 2H A T , 2H U R , 2H E ,2H<D,2HEG, 

12H C,2H ) 7 

DATA I PT72HP0, 2HTE, 2HNT, 2H I A, 2HL , 2H T E , 2H 11 P , 2H <,2H'DE,2HG , 

12H07 

DATA IHIKUS71H-7 

DATA r«S72HU I , 2HN0, 2H S , 2H P E , 2H E D , 2H (,2HM7,2HS)7 
DATA IUD72HUI,2HHD, 2H D , 2H I R , 2H E C , 2H T 1 , 2H 0 N , 2H (,2HDE,2HG)7 
DATA ISURT72HSU, 2HRF, 2HAC, 2HE ,2H ,2H ,2H ,2H ,2HT0,2HP , 

2HLA, 2HYE, 2HR ,2H , 2H ,2H ,2H ,2HB0,2HT ,2HLA, 

2HYE,2HR 7 

DATA I SURTl 72HSU , 2HRF , 2HAC , 2HE , 2H ,2HT0,2HP , 2HLA , 2H YE , 2HR , 

2H ,2HB0,2HT , 2H L A , 2H YE , 2H R 7 
DATA IDATL72HDA, 2HTE7 , IT IML72HT I , 2HME7 
DATA IALTL72H A,2H L,2H T,2H I,2H T,2H U,2H D,2H E7 
DATA TS UR X7 108. ,1 30. ,1 40. ,170. ,180. ,210. ,220. ,2 50. ,260. ,2 90., 
1300. ,330. ,340. ,370. ,380. ,410. ,420. ,450. ,460. , 490. 7 
DATA BS UR X71 08. 0,160. 0,182. 5, 242. 5, 265. 0,325. 0,347. 5, 407. 5, 430.0, 
490.07 

DATA IT0P72H T,2H0P7, I60T72H B,2H0T7 

DATA IXNUH72H10, 2H-5, 2H 0,2H 5 , 2 H 1 0 , 2 H 1 5 , 2 H2 0 , 2 H2 5 , 2 H3 0 , 2 H3 5 , 
2H40, 2H45, 2H507 
DATA X7 100. , 460. , 100. , 100. 7 
DATA Y790.,90.,90.,410.7 

DATA IYNUH72H ,2H 0,2H 4,2HOO,2H 8 , 2 HO 0 , 2 H 1 2 , 2 HO 0 , 2 H 1 6 , 2 HO 0 , 
12H20,2HOO,2H24,2HOO,2H28,2HOO,2H32,2HOO,2H36,2HOO,2H40,2H007 
C ** THIS IS THE ALTERNATE DATA SET WHICH IS BEING CREATED. THESE 
C ** CHARACTERS ARE 5 BY 6 RASTER UNITS IN SIZE 


A- 100 



DATA LCHAR/1H0/,IALT/2H01.2H23.2H45/2H67,2H89,2HAB.2HC0. 

1 2HEF,2HGH.2HIJ.2HKL.2HMN.2H0P,2HQR.2HST.2HUV. 

1 2HUX.2HyZi2H + -.2H*/',2H< )/ 

C ** THE FOLLOWING DATA STATEMENT CONTAINS OCTAL REPRESENTATION 
C *+ OF AN ALTERNATE CHARACTER SET AS FOLLOWS: 0-9, A-Z, AND 
C ■:'* SPECIAL CHARACTERS 

DATA lALTCH/ 36 B,41B,41B, 368,4*0, 0,21B,77B, IB, 4*0, 

1 23B,4SB,45B,31B,4*0,42B,41B,S1B,66B,4*0, 

1 14B,24B,77B,4B,4*0,72B,51B,51B,46B,4*0, 

1 36B,45B,45B,2B, 4*0, 60B,43B, 448,706,4*0, 

1 26B, 51B , 5 1 B, 26B , 4*0 , 20B, 518, 51B, 36B , 4*0 , 

1 37B,50B,50B,37B,4*0,77E,51B,51B,26B,4*0, 

1 36B,41B,41B, 22B,4*0,77B,41B,41B,36B,4*0, 

1 77B,51B,51B,41B,4*0,77B,50B,50B,40B,4*0, 

1 36B, 41B,45B,26B, 4*0,776,1 OB, 10B,77B, 4*0, 

1 0,41B,77B,41B,4*0,42B,41B,76B,40B,4*0, 

1 77B,14B, 22B , 4 IB , 4*0, 77B , 1 B , 1 B, 1 B, 4*0 , 

1 77B,20B,10e,20B,77B,3*0,77B,30B,6B,77B,4*0, 

1 36B,41B,41B,36B,4*0,77B,44B,44B,30B,4*0, 

1 34B,42B,42B,35B,4+0,77B,44B,46B, 316,4*0, 

1 22B,51B,45B,22B,4*0,40B,40B,77B,40B,40B,3*0, 

1 76B,1B,1B,76B,4*0,74B,2B,1B,2B,74B,3*0, 

1 76B, IB, 366, IB, 766, 3*0, 616, 126, 04B, 126,616,3*0, 

1 60B,10B,17B,10B,60B,3*0,41B,43B,45B,51B,61B,3*0, 

1 2+4B,37B,2*4B,3*0,5*4B,3*0,21B,12B,37B,12B,21B,3*0, 

1 IB, 26, 4B, lOB, 20B, 3* 0,0,36B,41B, 5*0, 0,416,366,5*0/ 

DATA I ALTCl /O, 12B , 1 2B , 12B, 4*0/ 

DATA I ALTP/0 , 1 B, 6*0/ 

DATA I ALTCL/0, 12B , 6*0/ 

DATA IALTSP/8*0/ 

DATA I MET/2H< M , 1 H >/ 

DATA I NSTAL/2HVA , 2HFB , 2HKS , 2HC / 

DATA I STAB/2HST, 2HAB, 2H H,2HT:/ 


C 

C*** CALL VERSION SUBROUTINE TO DETERMINE IF RUNNING ON 

C*** CRT OR PLASMASCOPE . . . . IVERSN = 0 FOR PLASMA IVERSN = 1 FOR CRT 

C 

CALL VERSNC I VERSN > 

C ** CALL GRAF<1) TO INITIALIZE PLASMASCOPE 
CALL GRAF< I ) 

C ** CALL CLEAR TO CLEAR PLASMASCOPE 
CALL CLEAR 

C *♦ CALL ALTERNATE CHARACTER SET 
CALL LALT<LCHAR, lALTCH, 10) 

CALL LALT< 1 HA, lALTCHC 8 1 ) , 26 ) 

CALL LALT( 1H + , lALTCHt 289 ), 6 ) 

CALL LALT( 1 H = , lALTC 1< 1 ), 1 ) 

CALL LALT< 1 H , lALTSP, 1 ) 

CALL LALT< IH : , lALTCL, 1 ) 

CALL LALTC IH . , lALTP , I ) 


0,1 
2,3 
4 , 5 
6 , 7 
8 , 9 
A,B 
C,D 
E , F 
G,H 
I , J 
K , L 
n , H 
0 , P 
Q , R 
S , T 
U , V 
U , X 
Y , Z 
+ , - 
/ , C 
= , SP 
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C ** CALL SETORCXORG, YORG ) TO INITIALIZE X,Y ORIGIN 
C ** CALL SETSCCXSCAL. YSCAL> TO SET SCALE FACTORS 
CALL SETSC< 1 . , 1 . ) 

CALL SETOR(0.,O. > 

C ** READ THE CONHON DISC FILE 
C 

CALL RUDIS( NAME. 0 ) 

C LINEtXi YiNXY.MODE) TO PLOT LINE 

C Xi Y = CO-ORDINATES 

C •* NXY = HUHBER OF POINTS TO BE PLOTTED 
C ♦* NODE = 0 SPECIFIES A WRITE. = 1 SPECIFIES AN ERASE 
C ** CALL POINT<X, Y. NXY .NODE ) SANE AS. ABOVE EXCEPT PLOTS POINTS 
C ** PRINT DATE 

CALL CHAR( 20 . . 490 . . 0. IDATL. 4. 2. 1 ) 

XL< 1 ) = 20 . 

XL<2 ) = 48 . 

YL< 1 ) = 488 . 

YL<2) = 488. 

CALL LINECXL.YL.2.0) 

CALL CODE 

WRITE! I DATE, 30 02 > I SDAY. 1SH0H( 1 ) , I SWON( 2 ) . ISYEAR 
3002 FORMAT! 12. IX. A2. Al. IX. 14 ) 

CALL CHAR<60,.490..0. I DATE. 11,2.1) 

C ** PRINT TINE 

CALL CHAR< 164. . 490. ,0 . ITINL,.4,2. 1) 

XL< 1 ) s 164 . 

XL<2) = 192. 

CALL LINE<XL/YL.2.0 ) 

CALL CODE 

WRITE! ITMNE, 3001 ) ISTIN 
3001 F0RMAT!I4) 

CALL CHAR!204..490..0.1TNHE,4,2.1) 

CALL CH AR !240. 0. 490. 0,0,IFLAG!4). 1,2,1) 

IF!IVERSN .EQ. 0)CALL CH AR ! 24 8 . 0 , 4 90 . 0 , 0 , L AU NT D ! 4 ) , 2 , 2 , 1 ) 
IF!IVERSN .EQ. 1 )CALL CH AR ! 24 6 . 0 . 4 90 . 0 , 0 , L AU N T D ! 4 ) , 2 , 2 , 1 ) 
IF! IFLAG! 3 ) . E Q . 0 ) GO TO 2 

I = IFLAG!3) - IFLAG!3)/3 ^ 

CALL CHAR!308.0.490,0,0,INSTAL(1,I).4,2,1) 

XL! 1 ) = 308 . 0 
XL!2 ) = 336 . 0 
CALL LINE! XL , YL. 2 ,0 ) 

C ** PRINT SURFACE PRESSURE AND DENSITY 
2 CALL CHAR! 20 . , 475 . . 0. ISURLl ,60. 2, 1 ) 

IF!IVERSN .EQ. 0) CALL C H A R ! 4 6 8 . , 4 78 . , 0 , I E XP 3 . 1 . 2 , 1 ) 

IF!IVERSH .EQ. 1) CALL C HA R ! 3 1 8 . , 4 78 . . 0 , I E XP 3 . 1 . 2 . 1 ) 

XL! 1 ) = 20 . 

XL! 2 ) = 76 . 

YL! 1 ) = 473 . 

YL! 2 ) = 473 . 

CALL LINE! XL, YL. 2,0 ) 
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IF<IVERSH .EQ. 0)GO TO 3 

CALL CHAR(374 . 47S .Oi 0/ ISTAB.8. 2, 1 > 

CALL CHAR(466.0,475.0,0<ISTL(4).1.2.1> 

XL< 1 ) = 374 . 0 
XL<2 ) = 422 . 0 
CALL LINE(XL<YL/ 2>0 ) 

CALL CODE 

WRITE < IPRESD, 2007) ALT(31) 

CALL CHAR(428.0M75.0.0,IPRESD/E.2<1) 

C ♦* PRINT SURFACE — TOP LAYER HEADER -- BOT LAYER HEADER <IF REQD ) 

3 IFCIVERSH .HE. 0 )G0 TO 4 
I = 20 

IF(IFLAG<2) .EQ. 1)1 = 32 

CALL CHARC222. 0. 461 .0/ 0/ ISURTl. I i 2< 1 ) 

GO TO S 

4 I = 26 

IF<IFLAG<2) .EQ. 1)1 a 44 

CALL CH AR (222.0. 461. 0.0>ISURT>I/2.1) 

5 XL( 1 ) = 222 . 

XL( 2 ) = 278 . 

YL< 1 > = 4 59 . 

YL<2 ) = 459 . 

CALL LINE(XL.YL/ 2.0 ) 

XL< 1 ) = 302 . 

XL< 2 ) * 374 . 

CALL LINECXL. YL. 2.0 ) 

IF<IFLAG<2) .HE. 1 )G0 TO 8 

XL< 1 ) = 398 . 0 

XL(2 > = 470 . 0 

CALL LINE< XL. YL. 2 .0 ) 

C ** PRINT DRY TEMPERATURE 

8 CALL CHAR( 30 .. 450 .. 0. IDT. 24,2. 1 ) 

C PRINT POTENTIAL TEMPERATURE 

CALL CHAR< 30 . , 440 . . 0. I PT . 22 , 2 . 1 ) 

C ** PRINT WIND SPEED 

CALL CHARC 30 . . 430 . . 0. I WS. 16 ,2. 1 ) 

C ** PRINT WIND DIRECTION 

CALL CHAR< 30 . . 420 . . 0. IWD.20. 2, 1 ) 

C ** DRAW X AXIS 

CALL LINE<X. Y. 2. 0 ) 

C ** draw Y AXIS 

CALL LINE< X< 3 ). Y< 3 ) .2. 0 ) 

C ** DO LOOP TO ADD TIC MARKS FOR X AXIS 
XTIC = 70. 

XT IC2< 1 ) = 88 . 

XT IC2( 2 ) = 92 . 

XNUMl = 62. 

00101=1.13 
XTIC = XTIC + 30. 

XT IC 1< 1 ) = XTIC 
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XTICU2) = XTIC 

CALL LINE<XTICl,XTIC2<2/0) 

XTICK 1 ) = XTICK 1) + 15. 

XTICK2) = XTICK2) + 15. 

IF< I .EQ . 13> GO TO 13 
CALL LINE<XTICliXTIC2,2,0> 

13 CONTINUE 

XNUMl = XNUNl + 30. 

IF(I.EQ.l) CALL CHAR< 84. <80 . . 0. IHIHUS, 1 ,2/ 1 > 

CALL CHAR<XNUHl<80.<0<IXHUtKI)<2<2.1> 

10 CONTINUE 

C ** DRAW TIC MARKS FOR UINO DIRECTION SCALE 
XWD2< 1 ) = 300 . 

XUD2<2> = 460. 

YUD2< 1 > = 70 . 

YUD2< 2 ) = 70 . 

YUOK 1 ) = 68 . 

YUDK2 ) = 72 . 

CALL LINE(XUD2< YUD2<2<0) 

CALL CHAR<310. <50 . < 0< IUD<20<2. 1 > 

C ** PRINT LABELS FOR X-AXIS 

CALL CHAR<100.,70.<0<ISTL<24<2<1) 

C ** 00 LOOP TO ADO TIC MARKS TO Y-AXIS 
YTIC = 58. 

XTIC2< 1 ) = 38. 

KTIC2<2) = 102. 

00 20 I = 1 < 11 
YTIC = YTIC + 32. 

YTIC2< 1 ) = YTIC 
YTIC2<2) = YTIC 
N = <I-1)*2 + 1 

CALL CHAR <64. <YTIC2<0<IY NUM<N)<4,2<1) 

CALL LINE<XTIC2< YTIC2<2<0) 

20 CONTINUE 

C ■** PRINT LABEL FOR Y-AXIS 
YX = 360. 

0 0 3 0 I = 1 < 8 
YX = YX - 20 . 

CALL CHAR<30.<YX<0<IALTL<I)<2,2<1) 

30 CONTINUE 

CALL CHAR <30. 0,YX -20.0, 0<IMET<3<2<D 
C ** THIS PRINTS SURFACE PRESSURE AND DENSITY VALUES 
A = PRESS< 1 > 

CALL CODE 

URITE< IPRESD,2007> A 
2007 F0RMAT<F6.1) 

IF<IVERSN .EQ. 0)CALL CH AR < 1 9 6 . < 4 7 5 . < 0 < I P R E S D < 6 , 2 < 1 ) 
IF<IVERSN .EQ. DCALL CH AR < 1 3 3 . < 4 7 5 . < 0 < I P R ES D < 6 , 2 < 1 ) 
A = SURDEN 
CALL CODE 
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«RITE< IDEHSD.2007 > ft 

IF<IVERSN .EQ. 0 >CALL CHftRf 388 . . 475 . , 0. IDENSD, 6 , 2 . 1 ) 
IFdVERSN .EQ. l)CftLL CH AR ( 26 0 . , 47 5 . . 0 . I D E N S D . 6 . 2 . 1 ) 
C *• PRINT DRY TEMPERATURES 
A = TEMP< 1 ) 

CALL CODE 

«R1TE( ISTP.2007) A 

CALL CHAR<230. ,450. ,0 , ISTP.6,2. 1 >, 

C PRINT POTENTIAL TEMPERATURES 

A = PTEHP< I ) - 27 3.15 > . , 

CALL CODE 

WR1TE< ISPT, 2007) A 

CALLCHAR<230.,440.,0,ISPT,6,2,1> 

DO 133 JJ=1 , HUH 

1F<ALT< JJ ).GE.4000. ) GO TO 3131 
HSY<JJ) =< ALT< JJ ))*. 08+ 80. 

DTYCJJ) =< ALT<JJ ))*.08+ 90. 

PTY(JJ) =< ALT( J J ) )* . 03+ 90. 

UDY(JJ) =< ALT< J J ) )* . 08+ 90. 

AMDIR<JJ)=IDIR(JJ) 

APTEMP<JJ) = PTEMP<JJ) - 273.15 

133 CONTINUE 

JJ = HUM +1 
3131 ILP = JJ - 1 
C 

C** CALL SUBROUTINE TO ROTATE WIND DIRECTION FOR PLOTTING 
C 

CALL HIHDS( AUDIR, ILP, ISC > 

DO 123 IK*1,9 

H = < IK-1 )*2 + 1 

CALL LINECXWDKN ),YWD1 ,2.0 ) . 

XBWD = XWDKN) - 8. 

YBWD = 60. 

IF(ISC.EQ.l) CALL C H A R ( X BW D , Y B U D , 0 , I M DL 1C H ) , 4 , 2 , 1 ) 
IFCISC.EQ.2) CALL C HA R < X BM D , Y BU D , 0 , I « DL 2 ( N ) , 4 , 2 , 1 ) 
IFCISC.EQ.3) CALL C H A R ( X BH D . Y B W D , 0 , I W DL 3C N ) , 4 , 2 , 1 ) 
IFCISC.EQ.4) CALL CHARC XBWD , YBWD , 0 , IWDL4( H >, 4, 2 , 1 ) 
123 CONTINUE 

DO 134 KK = 1 , ILP 

HSXCKK) =<SPEED< KK) )*6 . + 160. 

DTXCKK) =<TEMP<KK ))*6 . f 160. 

PTXCKK) =<APTEHPC KK ))*6. + 160. 

IFCTEMPCKK) . LT . - 10 . )DTX( KK ) = 100. 

IFCTEMPCKK) .GT. 50.) DTXCKK) = 460. 

IFC APTEMPCKK ) . LT . - 1 0 . )P TXC KK ) * 100. 

IFC APTEMPCKK ) .GT. 50.) PTXCKK) = 460. 

HbXCKK) = ABSC AWDIRCKK ))*. 444444 + 300. 

134 CONTINUE 

C ** PRINT WIND SPEEDS 
A » SPEED C l ) 
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CALL CODE 

WRITE( ISUS< 2007) A 

CALL CHAR<230..430..0.ISUS^e.2.1> 

C ** PRINT UIND DIRECTIONS 
A = IDIR< 1 > 

CALL CODE 

WRITE< ISWD. 2007 ) A 

CALL CHAR(230..420.>0.ISUD.S>2.1) 

C *+ THIS PORTION DRAMS THE WIND SPEED LINE 
CALL DLINE(ysX.«SY. ILP.0.8.4) 

XHT = USY(ILP) + 3. 

CALL CHAR<MSX<ILP).XHT,0,ICRVT(l>.2.2il ) 

C ** THIS PORTION DRAWS THE DRY TEMPERATURE LINE 
CALL LI NE< DTX. DT V , ILP . 0) 

XHT = DTY< ILP ) - 5.0 

CALL CHAR<DTX< ILP )+4 . 0 .XHT, 0. ICRVT( 2 ) i 2 , 2 , 1 ) 

C ** THIS PORTION DRAWS THE POTENTIAL TEMPERATURE LINE 
CALL OLIHE< PTX ,PTY, ILP .0.4, 4) 

XHT = PTY<ILP) + 3. 

CALL CHAR<PTX< ILP >. XHT. 0. ICRVT( 3 ). 2. 2. 1 > 

C ** THIS PORTION DRAWS THE WIND' DIRECTION LINE 
II = 1 

DO 777 1=2. ILP 

IF< AMDIR< I ) .GE. 0. ) GO TO 777 
HUMP =1-11 

CALL DL INE< WDX< I 1 ). WDY< 1 1 ). NUMP. 0. 4. 8 ) 

II = I 

777 CONTINUE 

NUMP = ILP - II + 1 

CALL DCINEC WDXU 1 ). WDY< 1 1 ). NUMP. 0. 4. 8 ) 

XHT = WDY< ILP ) -5.0 

CALL CHAR<HDX<ILP>+4.0.XHT.O.ICRVT<4),2,2.1) 

C ** THIS PORTION DRAMS TIC MARKS AT VALID DATA POINT OF Y AXIS 
DO 330 K= 1 . ILP 

YDTIC< 1 )= ALT<K )♦ .08 + 90 . 

YDTICC 2 ) = YDTICC 1 ) 

CALL LINE< XDTIC, YDT IC. 2. 0) 

330 CONTINUE 

DRAW THE CLOUD 

YCLOUD = ALT<31) • 0.08 + 90.0 
CALL CLOUD( 250 .0, YCLOUD) 

WRITE OUT THE TOP OF THE SURFACE LAYER LINE AND ALLOW IT 
TO BE MOVED UP AND DOWN 

CALL M0VEM<JTOP.ILP.2.ITOP.318.0iTSURX.10) 

TOPSUR = ALT(JTOP) 

C 
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IF REQUESTED, URITE OUT THE BOTTOM OF THE SURFACE LAYER 
LINE AND ALLOW IT TO BE MOVED UP AND DOWN 

IF<IFLAG(2) .HE. DGO TO 444 
CALL MOVEM<JBOT,ILP.i,IBOT,414.0,BSURX,5> 

ZB = ALT(JBOT) 

c ‘ - ' ' • 

C*** CHECK FOR CRT OR PLASMA VERSION 
C 

444 IF<IVERSN .EQ. 1 )GO TO 446 

CALL CHAR< 24 . , 16 . ,0 , IHARD< 1 ), 18, 3, <► > 

CALL CHAR< 1 68 . , 1 6 . , 0, IHARD< 10 >, 8 , 0 ,0 ) 

CALL CHAR<232 . . 1 6 . /O^ IHARDC14 >, 6 ,0,6 > 

CALL IN<1,JTYPE,0.,0.,0,0,0,0.31,0,31,IX,IY) 

IF( IX. GT. 15 ) GO TO 446 
CALL RUDI S< NAME, 1 ) 

CALL EXEC< 9 , RMETQ ) 

CALL RUDI S( NAME, 0 ) 

446 CONTINUE 

C ** CALL RUDIS TO PASS CHANGES IN COMMON DIS FILE 
C 

CALL RWDI S< NAME, 1 > 

C ** CALL NGRAF TO RE-INITIATE PLASMASCOPE 
CALL CLEAR 
CALL NGRAF 
STOP 
END 

SUBROUTINE U INDS< UD , HUD, ISC > 

DIMENSION «D< 1 ), ENDPT< 4),HUMUP< 4 ) 

EQUIVALENCE <J, LEAST) 

DATA ENDPT/0 . 0 , 90 . 0 , I 80 . 0, 270 . 0/ 

DO 2 1 = 1,4 
2 NUMUP< I ) = 0 
UD2 = «D< 1 ) 

DO 8 1=2, NUD 
WDl = UD2 
HD2 = UD( I ) 

DO 6 J=l,4 

Cl = UDl - ENDPT<J) 

IF< C 1 . LT . 0 .0 )C I = Cl + 360 . 0 

C2 = WD2 - EHDPT<0) 

1F<C2 .LT. 0.0)C2 » C2 + 360.0 
IF<ABS<C1-C2) .LE. 180.0)G0 TO 6 
NUMUP< J ) = HUMUP< J ) + 1 
6 CONTINUE 
8 CONTINUE 
ISC = 1 

LEAST = NUMUPC 1 ) 

DO 12 1=2,4 

IF<NUMUP<I) .GE. LEAST)GO TO 12 
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ISC = I 

LEAST = NUHUP(I) 

12 CONTINUE 

DO 17 1=1 ,NVO 

WD< I ) = WD< I ) - ENDPT< ISC) 

IF<WD<I) . LT . 0 . 0 )UD< I ) = UD(I) + 360.0 
17 CONTINUE 
UD2 = UD< 1 ) 

DO 22 r=2,HUD 
UDl = UD2 
UD2 = UD<: I ) 

I F( ABS< WD 1-UD2 ) . LE . 180.0)G0 TO 22 

WDd) = -UD<I) 

22 CONTINUE 
RETURN 
END 

SUBROUTINE CLOUD<XP,YP) 

c • • 

C COMMON BLOCK 

C 

COMMON ALT(31),AL1.C0NMAX,C0NCPK, DEGRAD, ADIR.DOSPK. El. CLDHT. 

IDIR<31),I0PTC3),ITIME,IDAY,M0NTH(2),IYEAR,ISTIH,ISDAY, 
ISMON<2>,ISYEAR,IV2,JTOP,JBOT,LAUHTD(10),LTIME,LTIM,LDAY, 
LM.0H<2;),LYEAR,LU,NUM,PI,PI0VR2,PI43,PRESSC31),PTEMP<31), 
SIGHCL,RADDEG,RAT0MC,CLDRAD,R2,R3,SAVEA<30),SAVER(30),SIGA, 
SIGX0,SIGX,SPEED<31),SQR2PI,SURDEN,SIGZ0.SIGAP,S8,TEMP<31), 
TOPSUR, TWOPI , ASPD , VPAR< 1 8 >, CRT IME( 3 1 ) , D I ST , YES, Y1 , NUMRUN, 
YPOS, IFLAGC5 ), 2B, ZZ, REFLEC, IRETRN 
LOGICAL LTIME 
INTEGER YES 

' EQUIVALENCE < Q C 1 , VP AR ( 1 > ) , ( QC 2 , V P A R< 2 ) ) , < Q C3 , V P AR ( 3 ) ) , 

i < QTl , VPAR< 4 ) ), ( QT2, VPAR( 5 > ) , ( QT3 , VP ARC 6 ) ), 

<AA,VPAR<7>),(BB,VPAR<8)),(CC,VPAR<9)>, 

CHEATN,VPARC10)),CHEATM,VPAR(1.1)),CHEATA,VPARC12)), 

C PHCL , VPARC 13 ) ) , ( PCO , VPARC 1 4 ) ) , ( PC02, VP ARC 15 ) ), 

C PAL203 , VPARC 1 6 ) ), C PN.O, VPARC 1 7 ) ) , C GAMMAX , VPARC 1 8 ) ) 
DIMENSION XC 181 ), YC 181 ) 

RADIUS = GAMMAX * ALTC31) * 0.08 
DO 7 1= I, 181 

XC I) = RADIUS COSC 0 . 01 745329252 * FL0ATC2 * I)> + XP 
7 YCI) = RADIUS + S INC 0 . 01 745329252 * FL0ATC2 * I>) + YP 
CALL LINECX, Y, 181 ,0 ) 

RADIUS = 5.0 


XC 1 ) 


XP + 

RADIUS 

XC 2 ) 

= 

XP 


XC 3 ) 

= 

XP - 

RADIUS 

XC 4 ) 

= 

XP 


X C 5 ) 

= 

XC 1 ) 


YCI) 

= 

YP 


YC 2 ) 

= 

YP + 

RADIUS 
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Y<3> * YP 

Y<4) = YP - RADIUS 
Y< 5 ) => Y< 1 ) 

CALL HHE<X>Y,5,0) 

X( 2) = XP - RADIUS 
YC2) = YP 

CALL LINECX. Y, 2. 0 ) 

X<3) = XP 

YC3) = YP + RADIUS 
CALL LINE<X<3).V<3)i2,0) 

RETURN 

END 

SUBROUTINE MOVEH<JND.HAXJHD>MIHJHD.LAB.XLABEL.XLIHE.HLIN£> 

C 

C COHHOH BLOCK 

C 

COMMON ALT<3n.ALl>COHMAX,COHCPK,OEGRAD,ADIR.DOSPK/El,CLDHT, 

I01R(31 I0PT<3)/ 1T1ME,1DAY,M0NTH(2>, IYEAR,ISTIM, ISDAY, 

ISM0N(2),1SYEAR,IV2/JT0P,JB0T.LAUHTD(10),LTIME,LTIM,LDAY, 
LM0M<2),LYEAR<LU,MUM,PI,PI0VR2,PI43,PRESS(31 ),PTEMP(31 ), 
SIGHCL> RAODEG. RATOMC, CLDRAD, R2 ,R3, SAVEA( 30 >, SAVER( 30 >. S IGA, 
SIGX0,SIGX,SPEED(31),SQR2PI,SURDEN,SIGZ0,SIGAP,S8,TEMP<31), 
T0PSUR,TW0PI,ASPD,VPAR(18),CRTIME<31),DIST,YES,Y1,NUMRUN, 
YPOS, IFLAG<5 >, 2B/ 2Z, REFLEC, IRETRN 
LOGICAL LTIHE 
INTEGER YES 

EQUIVALENCE < Q C 1 , VP AR ( 1) >, < QC 2 , VPA R< 2 ) ) , ( D C3 , V P AR ( 3 ) ) , 

< QTI , VPAR< 4 ) ), < QT2, VPARt 5 > ) , ( QT3 , VPAR( 6 •> >, 
<AA,VPAR<7>)/(BB,VPAR(8)),(CC,VPAR(9)>, 

(HEATH, VPAR(10)),<HEATM,VPAR(11)),(HEATA,VPAR(12)), 

<PHCL,VPAR<13)),(PC0,VPAR(14)),(PC02,VPAR<15)), 

<PAL203,VPAR(16)>,(PN0,VPAR<17)),CGAMMAX,VPAR(18)) 

2000 FORMAT < F6 , 1 ) 

2001 FORMAT < " " I 3 " . 0 " ) 

INTEGER QUES<13),ANS1,ANS2(2),AHS3(4),6LAHKS<26) 

DIMENSION LAB< 1),XLINE(1 ),YLIHE(2),JNDALT<3),JNDVAR(3,4) 
EQUIVALENCE ( J ND V R 1 , J H D V AR < 1 , 1 ) ) , ( J H D VR 2 , J ND V A R ( 1 , 2 ) ) , 
<JN0VR3,JNDVAR(1,3)),(JNDVR4,JNDVAR(1,4>) 

DATA QUES/2HM0,2HVE,2H ,2H ,2H 0,2HF , 2 H SU , 2 H RF , 2 H AC , 2 H E ,2HLA, 

2HYE , 2HR i 7 

DATA AHS1/2HUP7, AN S2 / 2HD0 , 2H WH 7 , AHS372HC0, 2HHT, 2H I N, 2HUE7 
DATA 6LANKS72S’)<2H 7 
NEWJND = 0 

1 YLINE(l) = ALT(JND) * 0.08 + 90.0 
YL INE( 2 > = YLINE< 1 ) 

DO 4 I=1,NLINE 
J = 2 * I - 1 

4 CALL LINE(XLINE< J ), YLINE,2, 0) 

Y = YL1NE< 1 > + 2.0 

CALL CHAR<460. 0, Y,0,LAB, 4, 2, 1 ) 
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Y = Y - 1 0. 0 
CALL CODE 

WRITE < JNDALT. 2000) ALT(JND) 

CALL CHAR<460.0/Y,0,JNDALT,6,2,1) 

CALL CODE 

WRITE < JNDVRl , 2000 ) TEMPCJND) 

YLABEL = PTEHP<JND) - 273.15 
CALL CODE 

WRITE < JNDVR2, 2000) YLABEL 
CALL CODE 

WRITE ( JNDVR3, 2000) SPEED<JNO) 

CALL CODE 

WRITE <JHDVR4,2001) IDIRCJND) 

YLABEL = 450.0 
DO 6 1=1,4 

CALL CHAR<XLABEL,YLABEL,0,JHDVAR<1,I),6,2,1) 
6 YLABEL = YLABEL - 10.0 

IF<HEWJND .EQ. JND)GO TO 11 
0UES<3 ) = LAB< 1 ) 

QUES<4) = LAB<2) 

CALL CHARC<0.0,1.0,-1,QUES,26,3,0) 

CALL CHARC<29.0,1.0,-1,ANS1,2,0,0) 

CALL CHARC<3B.0,1.0,-1,ANS2,4,0,0) 

CALL CHARC(43.0,1 .0,-1, A NS 3, 8, 3,0) 

11 CALL I N< 1 , J , 0 . 0, 0 . 0 ,0, 0, 0, 0 , 31, 0 , 31 , I , J ) 

IF(I .L£. 20)G0 TO 15 

CALL CHAR <0.0,1. 0,-1, BLANKS, 51, 0,0) 

RETURN 

15 IF<I .GE. 17)G0 TO 18 

NEUJNO = MINOCJND + 1,MAXJND) 

GO TO 22 

18 NEWJND = MAXOCJHO - 1,11INJND) 

22 IF<NEWJND .EQ. JND)GO TO 11 
DO 24 1=1 ,HLINE 
J = 2 * I - 1 

24 CALL LINE(XLINE< J ), YLINE,2, 1 ) 

CALL CH AR <460. 0, Y,0,JN DA LT, 6,1,1) 

Y = Y + 10. 0 

CALL CHAR< 460 . 0, Y , 0 , LAB, 4, 1 , 1 ) 

YLABEL = 450.0 
DO 26 1=1,4 

CALL CHAR<KLABEL, YLABEL, 0, JNDVAR< 1 , I ),6, 1 , 1 ) 
26 YLABEL = YLABEL - 10.0 
JND = NEWJND 
GO TO 1 
END 

SUBROUTINE RWD IS< NAME , J J ) 

COMMON BLOCK 
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COHHOH ALT( 31 >iALl< COHHAX. COKCPK , DEGRAD. ADIR. DOSPK/ El . CLDHT . 

IDIR< 31 ). IOPT< 3 ) / ITIHEi IDAY ,HONTH< 2 >'. lYEAR. ISTIM. ISDAY. 

ISH0H<2 ). ISYEAR , IV2. JTOP. JBOT . LAUHTD( 10),LTIME.LTIH,LDAY. 

LK0H<2>*LYEAR. LU.HUH.PI.PI0VR2,PI43.PRESS( 31 ).PTE«P( 31 ), 

SIGHCL. RAD0EG.RAT0HC.CLDRAD.R2 >R3. SAVEA( 30 SAVER( 30 >. SIGA. 

SIGX0.SIGX.SPEE0C31 >.SQR2PI .SURDEH. SIGZO.SICAP. S8. TEHPC 31 >. 

TOPSUR. TUOPl .ASPD.VPAR< 18 >. CRTIHEC 31 >.DIST. YES. Y1 . NUHRUN. 

YPOS. IFLAG(S).ZB.ZZ.REFLEC. IRETRN 
LOGICAL LTINE 
INTEGER YES 

EQUIVALENCE ( QC 1 . VP AR< 1 > >. < QC2. VPAR< 2 > > . ( Q C3 . VP AR< 3 ) >. 

<QT1 . VPARC4) ). < QT2. V P A R( 5 > ) . ( ft T3 . V P AR < 6 ) ) . 

<AA. VPAR< 7 >).( BB. VPAR< 8 ) ) , ( CC . VPAR< 9 ) ). 
<HEATN.VPAR<10)>.<HEATH.VPAR<11)>.<HEATA,VPAR(12)>, 
<PHCL.VPAR<13)).<PC0,VPAR(14)).(PC02.VPAR(15)), 
<PAL203.VPAR<16>>,(PN0.VPAR<17>),(GANMAX.VPAR<18)) 
INTEGER ODCB( 144 ) .0BUFC669 > 

DIHENSION HAHE<3) 

EQUIVALENCE < 06UF< 1 ). ALT( 1 ) > 

CALL OPEH(ODCB.1ERR.HAHE.O> 

IFtJJ.EQ.DCALL «RITF<0DCB.IERR.0BUF.669> 

IF( J J . EQ. 0)CALL R E A DF < OD CB . I E R R . OB UF . 66 9 ) 

CALL CLOSE<ODCB. lERR) 

RETURN 

END 

END* 
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PROGRAM RMETQ 
COMMON BLOCK 

COMMON ALT<31).ftLl/C0HMftX,C0NCPK>DECRAD,ADIR,D0SPK,El.CLDHTi 

IDIR<31).I0PT(3).ITIME.IDAY.M0NTH<2)/IYEAR,ISTIM.ISDAY, 
ISM0N<2). ISYEflR.IV2,JT0P,JB0T.LAUNTD< H>).LTIME.LTIM.LDAY, 
LM0N(2),LYEftR,LU,NUM,PI,P10VR2.P143,PRESS(31),PTEMP(31), 
SIGHCL.RADDEG.RAT0MC.CLDRAD,R2,R3.SftVEfi<30).SftVER(30),SIGA> 
SIGX0<SIGX.SPEED(31),SQR2PI<SURDEH-SIGZ0,SICAP.S8.TEMP<31). 
T0PSUR.TH0PI.ASPD,VPAR(18>,CRTIME(31).DIST,YES,Y1,NUMRUN, 
YP0S,IFLAG(5).ZB.22,REFLEC.IRETRN 
LOGICAL LTIME 
INTEGER YES 

EQUIVALENCE <QC1,VPAR(1>)>(QC2.VPAR(2>>.(QC3,VPAR(3>). 

(QT1.VPAR(4)),<QT2,VPAR(5>)<<QT3.VPARC6)). 
<AA>VPAR<7>),(BB,VPAR<8)),(CC.VPAR(9)). 
<HEATN.VPAR<10)),(HEATM>VPAR(11)).(HEATA,VPAR<12)>/ 
(PHCL,VPAR<13)>,(PC0,VPAR(14)),(PC02.VPAR(15)). 
<PAL203,VPAR<16)).(PN0.VPAR(17>),CGAMMAX,VPAR<13)> 
DIMENSION USX<31),USY<31)<DTX<31),DTY(31),PTX(31).PTY(31>, 

1 UDX< 31 ) ; UDY< 31 ) 

DIMENSION ISTP<3)-ITTP(3).ISPT(3)<ITPT(3).ISUS<3).ITUS(3) 

DIMENSION ISUD<3>.ITUD<3).XDTIC<2),VDTIC(2).ICUR1(21) 

DIMENSION ITEST(10),TPR<6).IDCB(144) 

DIMENSION X(4)/Y<4)-XTICl(2).XTIC2(2)iYTICl(2).YTIC2<2) 

DIMENSION XS<2)/YS(2),IALTL(8)<TSIJRX(20).BSURX(10) 

DIMENSION I ALTCH( 336 ) , IALT< 22 ) 

DIMENSION IXNUMC 13).IYNUM(22),IALTC1(8) 

DIMENSION ITEMPD(3).IPRESD(3),IDENSD(3) 

DIMENSION IDATL< 2 ITIML(2 ) 

DIMENSION IDATE( 6 AUDIR(31 ) 

DIMENSION ITMME(2.’' 

DIMENSION APTEMP( 31 ) 

DIMENSION XL<2),YL<2), IDT( 12),!PT< 11 ),IUS<8).I(JD( 10) 

DIMENSION I SURLl ( 30 )/ I ALTSP( 8 ) 

DIMENSION ISURT< 22 ) . I ALTP( 8 ), lALTCLC 8 ) 

DIMENSION ICRVT<4),ISTL(12),IT0P(2).YUD1(2).YWD2(2)<XWD1(18) 
DIMENSION IB0T<2) 

DIMENSION XWD2<2),IUDL1(18>,IUDL2(18),IUDL3(18>,IIJDL4<18) 

DIMENSION I TPV< 3 j , NAMEC 3 ) 

DIMENSION IMET<2>.INSTAL(2,2),ISTABi:4) 

DATA NAME/036522B , 2HEE , 1 HD/ 


DATA 

IUDL1/2H 0,2H 

, 2H . 

2H 

, 2H 9, 2H0 

, 2H ,2H 

/ 

2H1 8. 2H0 


2H . 2H 

. 2H27, 

2H0 

. 2H 

, 2H 

- 2H36. 2H0 

/ 


DATA 

I UDL2/2H90, 2H 

/ 2H 

2H 

, 2H1 8, 2H0 

, 2H . 2H 

J 

2H27, 2H0 


2H . 2H 

. 2H36. 

2H0 

, 2H 

, 2H 

. 2H90. 2H 

/ 


DATA 

I MDL 3/ 2H1 8. 2 HO 

/ 2H / 

2H 

, 2H27, 2H0 

, 2H . 2H 

/ 

2H36, 2H0 


2H , 2H 

/ 2H90, 

2H 

, 2H 

, 2H 

.. 2H18. 2H0- 

/ 
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DATA IUDL4/2H27, 2H0 , 2H .2H .2H36.2H0 /2H ,2H ,2H90.2H / 

2H .2H ,2H18.2H0 .2H .2H .2H27.2H0 / 

DATA XWDl/300. ,300. ,320. ,320. ,340. ,340. ,360. ,360. ,380. ,380. , 

1 400 . , 400 . , 420 . , 420 . , 440 . , 440 . , 460 . , 4 60 . 7 

DATA ICRVT72HUS, 2H0T, 2HPT, 2HUD/ 

DATA IEXP3/2H3 / 

DATA ISTL/2HSP,2HEE,2HD< ,2HM7,2HS),2H , 2 H T E , 2 H MP , 2 H ( D , 2 H EG , 2 H C, 

12H> / 

DATA ICUR 172HT0, 2HUC, 2HH , 2 H V - , 2 H A X , 2 H I S , 2 H T,2H0 ,2HEN, 

12HTE,2HR ,2HT0,2HP ,2H0F,2H S , 2 H UR , 2 H F A , 2 H CE , 2 H L,2HAY,2HER7 
DATA TPR/139 . , 187 . , 236 . , 285 . , 334 . , 383 . 7 
DATA XDTIC7100 .,106.7 

DATA ITEST72H ,2H ,2H ,2H ,2H ,2H ,2H ,2H ,2H ,2H 7 

DATA I SURLl 72HSU , 2HRF , 2HAC , 2HE ! , 2H 

2H , 2HPR , 2HES , 2HSU , 2HRE , 

2H ,2H ,2H , 2H , 2H II , 

2HB ,2H ,2H , 2H D,2HEH, 

2HSI,2HTY,2H , 2H , 2H 
2H ,2H G,2H7M,2H , 2H 7 

DATA IDT72HDR,2HY , 2H T E , 2H H P , 2H E R , 2H A T , 2H U R , 2H E ,2H(D,2HEG, 

12H C , 2H > 7 

DATA IPT72HP0, 2HTE, 2HNT, 2HI A, 2HL , 2H T E , 2H M P , 2H C,2HDE,2HG , 

12H07 

DATA IUS72HUI, 2HHD, 2H S , 2H P E , 2H E D , 2H <,2HM7,2HS>7 
DATA IUD72HUI, 2HHD, 2H D , 2H I R , 2H E C , 2H T 1 , 2H 0 N , 2H (,2HDE,2HG>7 
DATA ISURT72HSU, 2HRF, 2HAC, 2HE ,2H ,2H ,2H ,2H ,2HT0,2HP , 
2HLA, 2HYE, 2HR ,2H , 2H , 2H ,2H ,2H80,2HT ,2HLA, 
2HYE,2HR 7 

DATA IDATL72HDA,2HTE7, ITIML72HTI,2HME7 

DATA IALTL72H A,2H L,2H T,2H I,2H T,2H U,2H D,2H E7 

DATA IHINUS71H-7 

DATA TSURX7108., 130. ,140. ,170. ,180. ,210. ,220. ,250. ,260. ,290., 
1300. ,330. ,340. ,370. ,380. ,410. ,420. ,450. ,460. ,490.7 
DATA BSURX7108. 0,160. 0,182. 5, 242. 5, 265. 0,325. 0,347. 5, 407. 5, 430.0, 
490.07 

DATA IT0P72H T,2H0P7, IB0T72H B,2H0T7 

DATA IXNUH72H10, 2H-5, 2H 0,2H 5 , 2 H 1 0 , 2 H 1 5 , 2 H2 0 , 2 H2 5 , 2 H3 0 , 2 H3 5 , 
2H40, 2H45, 2H507 
DATA X7100 . , 460 . , 100 . , 100 . 7 
DATA Y790 . , 9 0 . , 9 0 . , 4 1 0 . 7 

DATA IYNUM72H ,2H 0,2H 4,2H00,2H 8 , 2 HO 0 , 2 HI 2 , 2 HOO , 2 H 16 , 2 HO 0 , 
12H20,2HO0,2H24,2HO0,2H28,2H00,2H32,2HO0,2H36,2HO0,2H40,2HO07 
C THIS IS THE ALTERNATE DATA SET WHICH IS BEING CREATED, THESE 
C ** CHARACTERS ARE 5 BY 6 RASTER UNITS IN SIZE 

DATA LCHAR71H07, IALT72H01,2H23,2H45,2H67,2H89,2HAB,2HCD, 

I 2HEF,2HGH,2HIJ,2HKL,2Ht1N,2H0P,2HQR,2HST,2HUV, 

1 2HWX,2HYZ,2H+-,2H*7,2H< >7 

C ** THE FOLLOWING DATA STATEMENT CONTAINS OCTAL REPRESENTATION 
C •* OF AN ALTERNATE CHARACTER SET AS FOLLOWS: 0-9, A-2, AND 
C *♦ SPECIAL CHARACTERS 7, <,) 
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DATA IALTCH/36B,418,41B,36Bi4f0,0i2iB,77BilB,4*0, 

1 23BM5B I 45B. 31 B .4*0. 42B, 4 IB .516. 66B , 4*0 , 

1 14B. 2 4B. 77B.4B. 4*0. 72B.51B.51B, 468.4*0. 

1 36B. 45B . 45B. 26 . 4*0. 606. 43B. 44B. 70B . 4*0. 

1 26B.51B.51B. 266.4*0.208.516.516. 366.4*0. 

1 37B.50B.50B.37B.4*0.77B.51B.51B.26B.4*0. 

1 36B.41B.41B. 2 2B . 4* 0 . 7 7B . 4 1 B . 4 1 B . 3 66 . 4* 0 . 

1 77B. 51B.51B.41B. 4*0. 77B. SOB. 506.408.4*0, 

1 36B.41B.45B.26B.4*0.77B.10B.10B.77B.4*0, 

1 0.41B.77B.41B.4*0.42B.41B.76B.40B.4*0v 

1 77B.14B. 226 .418 . 4*0. 77B. 1 B . 1 B. 1 B, 4*0 , 

1 77B.20B.10B.20B.77B.3*0.77B,30B.6B.77B.4*0. 

1 366. 418. 416.366.4*0. 778.446,446. 306, 4*0, 

1 34B,42B,42B,35B,4*0.77B.44B.46B,31B,4*0, 

1 22B, 51B.45B.22B. 4*0, 40B.40B,77B, 406.406,3*0. 

1 76 B. 16. IB. 76 B. 4 *0.748. 26. 16, 26. 746. 3*0. 

1 76 B. IB. 366.16.766.3*0. 616. 126. 046. 126.616.3*0. 

1 606. 1 06. 176. 106. 6 OB. 3*0. 416. 436. 45 6. 516. 61B. 3*0. 

1 2*46. 376. 2*46. 3*0. 5*46. 3*0. 216. 126. 376. 126. 216. 3*0, 

1 16,26.46.106.206.3*0.0.366,416.5*0.0,416,366,5*0/ 

DATA I ALTCl/0. 126 , 1 26 . 126. 4*0/ 

DATA IALTP/0. IB. 6*0/ 

DATA IALTCL/0. 126,6*0/ 

DATA IALTSP/8*0/ 

DATA IMET/2H<M. IH )/ 

DATA INSTAL/2HVA. 2HFB. 2HKS, 2HC / 

DATA ISTAB/2HST. 2HAB. 2H H.2HT!/ 

C ** CALL GRAF<1) TO INITIALIZE PLASHASCOPE 
CALL GRAF< 1 ) 

C ** CALL CLEAR TO CLEAR PLASHASCOPE 
C CALL CLEAR 

C **‘CALL ALTERNATE CHARACTER SET 
!CALL LALT<LCHAR. IALTCH. 10) 

■CALL LALTC 1 HA. IALTCH< 8 1 ) . 26 > 

CALL LALTC 1 H + . I ALTCH( 289 ). 6 ) 

CALL LALTC 1 H = . lALTC 1< 1 ). 1 ) 

CALL LALTC 1 H . lALTSP. 1 > 

CALL LALTC IH : . lALTCL. 1 ) 

CALL LALTCIH., lALTP.l ) 

C ** CALL SETORC XORG , YORG ) TO INITIALIZE X.Y ORIGIN 
C ♦* CALL SETSCC XSCAL. YSCAL ) TO SET SCALE FACTORS 
CALL SETSCC 1 . . 1 . ) 

CALL SETORC 0 . . 0 . ) 

C *♦ READ THE COMMON DISC FILE 
C 

CALL RUDISC NAME, 0 ) 

C ** LINECX, Y.NXY.MODE) TO PLOT LINE 
C ** X. V = CO-ORDINATES 

C ** NXY * NUMBER OF POINTS TO BE PLOTTED 
C ** MODE = 0 SPECIFIES A WRITE. = 1 SPECIFIES AN ERASE 


0,1 
2.3 
4.5 
6.7 
8.9 
A. 6 
C.D 
E.F 

G. H 
I . J 
K.L 

H. N 
O.P 
Q . R 
S.T 
U. V 
U.X 
Y.Z 
+ . - 
/ ,C 

= ,SP 
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C CALL POINKX, Y, NXY.MODE ) SAHE AS ABOVE EXCEPT PLOTS POINTS 
C ** PRINT DATE 

CALL CHARC20 . M90 . , 6. IDATL. 2/ 1 ) 

XL< 1 > * 20 . 

XL<2 ) = 48. 

YL< 1 ) = 488 . 

YL(2 ) = 488 . 

CALL LINECXLiYL. 2,0 ) 

CALL CODE 

yR ITE( IDATE , 3002 ) 1 SO A Y, ISMOH< i ) , I SHONC 2 ) , IS YEAR 
3002 FORNAT< 12, IX, A2, Al, IX, 14 > 

CALL CH AR <60. , 490. ,0, IDATE, 11,2,1) 

C ** PRINT TINE 

CALL CHAR<164.,490.,0,ITIHL,4,2,1> 

XL< 1 ) = 164. 

XL< 2 ) = 192. 

CALL LINE< XL , YL, 2 , 0 ) 

CALL CODE 

yRITE< ITMME, 3001 ) ISTIN 
3001 F0RHAT<I4) 

CALL CHAR<204. , 490. ,0, ITMNE,4,2, 1 ) 

CALL CHAR<240.0,490.0,0,IFLAG<4>,1,2,1) 

CALL CHAR<246.0,490.0,0,LAUNTD<4),2,2,1) 

IF<IFLAG<3) .EQ. 0)G0 TO 2 
I = IFLAG<3) - IFLAG<3)/3 

CALL CHAR<308.0,490.0,0,IHSTAL<1,I),4,2,1) 

XL< 1 ) = 308 . 0 
XL< 2 ) = 336.0 
CALL LINE<XL , YL, 2 , 0 ) 

C ** PRINT SURFACE PRESSURE AND DENSITY 
2 CALL CHAR< 20 . , 475 . , 0, ISURLl ,60, 2, 1 ) 

CALL CHAR<318. ,478 ,0, lEXP 3, 1,2,1) 

XL< 1 ) = 20. 

XL<2 ) = 76. 

YL< 1 ) = 473 . 

YL< 2 ) = 473 . 

CALL LINECXL , YL, 2 ,0 ) 

CALL CHAR(374.0,475.0,0,ISTAB,8,2,1) 

CALL CHAR<466.0,475.0,0,ISTL(4),1,2,1) 

XL< 1 ) = 374 . 0 
XL<2 ) =422.0 
CALL LINE<XL,YL,2,0) 

CALL CODE 

WRITE ( IPRESD, 2007 ) ALT<31) 

CALL CHAR<428 . 0, 475 .0, 0, IPRESD, 6 , 2, 1 ) 

C ♦* PRINT SURFACE -- TOP LAYRT HEADER -- BOT LAYER NEADER <IF RE8D) 
I = 26 

IF< IFLAG< 2) .EQ. 1 )I = 44 

CALL CH AR (222. 0, 461. 0,0,ISURT, 1,2,1) 

XL< 1 ) = 222 . 
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XL(2> * 278. 

YL<1 ) = 458. 

YL<2) = 458. 

CALL LINECXL. YLi 2,0 ) 

XL< 1 ) = 302. 

XL(2) = 374. 

CALL LIHE<XL,YL, 2.0 ) 

IF<1FLAG<2> .NE. 1> GO TO 8 
XLU ) = 388 . 

XL<2) » 470. 

CALL LINE<XL.YL.2.0 ) 

C PRINT DRY TEMPERATURE 

8 CALL CHAR(30 .. 450 .. 0. IDT. 24.2, 1 > 

C ** PRINT POTENTIAL TEMPERATURE 

CALL CHAR<30 . . 440 . . 0. IPT.22. 2. 1 > 

C *♦ PRINT WIND SPEED 

CALL CHAR(30 . . 430 . . 0. lUS. 16. 2. 1 > 

C ** PRINT UIND DIRECTION 

CALL CHAR(30 .. 420 .. 0. lUD. 20.2. 1 > 

C ** DRAU X AXIS 

CALL LINE<X. Y. 2. 0 ) 

C ** DRAM Y AXIS 

CALL LINE(X< 3).Y< 3). 2.0) 

C ** DO LOOP TO. ADD TIC MARKS FOR X AXIS 
XTIC = 70. 

XTIC2< 1 ) = 88. 

XT1C2< 2 ) » 82 . 

XHUMl = 62. 

DO 10 I = 1.13 
XTIC = XTIC + 30. 

XTICK 1 ) = XTIC 

XTICK 2 ) = XTIC 

CALL LINE<XTIC1. XTIC2.2.0) 

XTICK 1 ) = XTICK 1 ) + 15. 

XTICK 2) = XTICK2) + 15. 

IF<I.EQ.13) GO TO 13 
CALL LINE<XTIC1. XTIC2. 2.0) 

13 CONTINUE 

XHUMl = XNUMl + 30, 

IFCI.EQ.l) CALL C HA R< 8 4 . , 80 . . 0. I H I NU S . 1 . 2 , 1 ) 
CALL CHAR(XNUM1.80..0.IXHUM(I).2.2.1) 

10 CONTINUE 

C ** DRAH TIC MARKS FOR WIND DIRECTION SCALE 
XWD2< 1 ) = 300. 

XWD2<2) = 460. 

YWD2< 1 ) = 70 . 

YWD2C2 ) = 70 . 

YWDK 1 ) = 68 . 

YWDK2) = 72. 

CALL LINECXUD2. YUD2.2. 0) 
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CALL CHARC310. iSO . , 0, IUD,20.2 , 1 > 

C ♦♦ PRINT LABELS FOR X-AXIS 

CALL CHAR(100.i70.,0.ISTLi24>2.1> 

C ** DO LOOP TO ADD TIC HARKS TO Y-AXIS 
YTIC = 58. 

XTIC2< 1 > = 98. 

XTIC2( 2 > a 102 . 

DO 20 I = 1.11 
YTIC » YTIC + 32. 

YTIC2C 1 ) = YTIC 
YTIC2< 2 ) = YTIC 
H = < I-l )*2 + 1 

CALL CHAR(64..YTIC2.0.IYHUH(H).4.2.1> 

CALL LINE(XTIC2. YTIC2. 2. 0> 

20 CONTINUE 

C ** PRINT LABEL FOR Y-AXIS 
YX = 360. 

DO 30 I = 1 . 8 
YX = YX - 20 , 

CALL CHAR(3 0'..YX.0,IALTL<I),2.2,1) 

30 CONTINUE 

CALL CHAR(30..YX-20.,0.II1ET,3i2,l) 

C ** THIS PRINTS SURFACE PRESSURE AND DENSITY VALUES 
A = PRESS< 1 > 

CALL CODE 

WRITE< IPRESD,2007 ) A 
2007 F0RHAT(F6.1> 

CALL CHAR(133.i475.,0,IPRESD/6;2.1) 

A = SURDEN 
CALL CODE 

«RITE< IDENSD.2007 > A 

CALL CHAR<2€0.,475..0,IDENSD.6.2.1) 

C ** PRINT DRY TEMPERATURES 
A = TEMPCl) 

CALL CODE 

WRITE< ISTP, 2007) A 

CALL CHAR<230..450..0.ISTP.6,2.1> 

C ** PRINT POTENTIAL TEMPERATURES 
A = PTEMP< 1 ) - 273.15 
CALL CODE 

«RITE< ISPT. 2007) A 

CALL CHAR<230..440..0.ISPT.6.2.1) 

DO 133 JJ=1/NUM 

IF(ALT< JJ ). GE. 4000. ) GO TO 3131 
MSY<JJ) =< ALT< J J ) )* . 08+ 90. 

DTY(JJ) =< ALT< J J ))*. 08+ 90. 

PTY<JJ) =< ALT< J J ) )* . 08+ 90. 

MDY<JJ) =< ALT< J J ))*. 08+ 90. 

AUDIRC J J ) = ID1R< Jj ) 

APTEMP<JJ) = PTEMP<JJ) - 273.15 
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133 CONTINUE 

JJ = NUN + 1 
3131 ILP = JJ - 1 
C 

C** CALL SUBROUTINE TO ROTATE WIND DIRECTION FOR PLOTTING 
C 

CALL UIHDS( AVOIR, ILP/ ISC > 

DO 123 IK=li9 

N = < IK-1 )*2 + 1 

CALL LIHE(XUDKN ),YWD1 ,2,0 > 

XBUD = XUDKN) - 8. 

YBUD = 80. 

IF<rSC.EQ.I> CALL CHAR< XBWD , YBUD , 0 , I WDL 1( H ), 4, 2 , 1 ) 
IF<ISC.EQ.2> CALL CHAR< XBUD , YBUD , 0 , I UDL2( N ), 4, 2 , 1 > 
IF(ISC.EQ.3) CALL C H A R < XBU D , YBU D , 0 , I U DL 3( N > , 4 , 2 , 1 > 
IF(ISC.EQ.4) CALL C H A R ( X 6U D , Y 6U D , 0 , I UDL4( N > , 4 , 2 , 1 ) 
123 CONTINUE 

DO 134 KK=1,ILP 

«SX(KK) =(SPEED<KK) >*6 . + 160. 

DTX(KK) =<TEMP<KK >)*6. + 160. 

PTX<KK> =C APTEMP< KK > )*6 . + 160. 

IF(TE«P(KK) .LT.-IO . )DTX<KK) = 100. 

IF(TE«P(KK) .GT. 50.) DTX(KK) = 460. 

IF< APTEMPCKK ) . L T . - 1 0 . )P TX ( KK ) = 100. 

IF< APTEMPt KK ) .GT. 50.) PTX(KK) * 460. 

UDXCKK) * ABS< AUDIR(KK ))*. 44444 + 300. 

134 CONTINUE 

C ** PRINT WIND SPEEDS 
A = SPEED< 1 ) 

CALL CODE 

WRITE< ISWS, 2007) A 

CALL CHARC 230 . , 430 . , 0 , ISWS , 6, 2, 1 ) 

C ** PRINT WIND DIRECTIONS 
A = ID IR< 1 > 

CALL CODE 

WR1TE< ISWD,2007) A 

CALL CHAR(230.,420.,0,ISWD,6,2,1> 

C ** THIS PORTION DRAWS THE WIND SPEED LINE 
CALL DLINE(WSX,WSY, ILP,0,8,4) 

XHT = WSY<ILP> + 3. 

CALL CHAR<WSX(ILP),XHT,0,ICRVT(1),2,2,1) 

C ** THIS PORTION DRAWS THE DRY TEMPERATURE LINE 
CALL LINE<DTX,DTY,ILP,0) 

XHT = DTY< ILP) - 5.0 

CALL CHAR<DTX<ILP)+4.0,XHT,0, ICRVT(2),2,2,1) 

C ** THIS PORTION DRAWS THE POTENTIAL TEMPERATURE LINE 
CALL DLINE(PTX,PTY, ILP,0,4,4) 

XHT = PTY<ILP) + 3. 

CALL CHAR(PTX(ILP),XHT,0,ICRVT<3),2,2,1) 

C ** THIS PORTION DRAWS THE WIND DIRECTION LINE 
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11 = 1 

DO 77P 1=2, ILP 

IF<ft«DIR<I) .GE. 0.) GO TO 777 
NUHP =1-11 

CALL OLINE< WDX< I 1 ), yOY< 1 1 ), NUMP, 0, 4, 8 ) 

11 = 1 

777 CONTINUE 

HUMP = ILP - II + 1 

CALL DLIHE( UOX< 1 1 >, UOY( 1 1 > , NUMP, 0, 4, 8 > 

XHT = WDY<ILP) - 5.0 

CALL CHAR<«DX<ILP>+4.0,XHT,0,ICRVT<4),2,2,1) 

C ♦♦ THIS PORTION DRAUS TIC HARKS AT VALID DATA POINT OF Y AXIS 
DO 330 K=l, ILP 

YDTIC<1)= ALT<K>* .08 + 90. 

YDTIC<2) = YDTIC( 1) 

CALL LINE<XDTIC, YDTIC, 2, 0) 

330 CONTINUE 

DRAW THE CLOUD 

YCLOUD = ALT<31) * 0.08 + 90.0 
CALL CL0UD<250.0, YCLOUD) 

WRITE OUT THE TOP OF THE SURFACE LAYER LINE 

CALL MOVEMC JTOP, ILP,2, IT0P,318.0,TSURX, 10) 

IF REQUESTED, WRITE OUT THE BOTTOM OF THE SURFACE LAYER LINE 

IF(IFLAG(2) -HE. DGO TO 444 
CALL M0VEM<JB0T,ILP,1,1B0T,414.0,BSURX,5) 

CALL NGRAF TO REINITIALIZE PLASHASCOPE 

CALL CLEAR 
444 CONTINUE 

CALL NGRAF 

STOP 

END 

SUBROUTINE U INDS< UD , NHD, ISC ) 

DIMENSION WD< 1 ), ENDPT( 4 ), NUMUP( 4 ) 

EQUIVALENCE <J, LEAST) 

DATA ENDPT70. 0,90. 0,180. 0, 270.0/ 

DO 2 1=1, 4 
2 NUMUPC I ) = 0 
WD2 = UD< 1 ) 

DO 8 1=2, HWD 
UDl = UD2 
WD2 = UD< I ) 

DO 6 J = l, 4 
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Cl » VDl - ENOPTCJ) 

IF<C1 .UT. 0.0)C1 » Cl + 360.0 
C2 « VD2 - EHDPKJ) 

IF<C2 .LT. 0.0)C2 » C2 + 360.0 
IF(ftBS< C1-C2 ) .LE. 180.0>G0 TO 6 
HUHUPC J > * NUHUPC J > + 1 
6 CONTINUE 
8 CONTINUE 
ISC = 1 

LEAST > NUHUP< 1 > 

DO 12 1=^2. 4 

IF(HUHUP<I> .GE. LEAST>GO TO 12 
ISC = I 

LEAST = NUHUP< I > 

12 CONTINUE 

DO 17 I=1/HUD 

WD(I ) = «D< I ) - ENDPTC ISC) 

IF(UD(I) .LT. 0.0)UD<I) = «D(I) + 360.0 
17 CONTINUE 
UD2 » UD( 1 ) 

DO 22 1-2, UVD 
UDl = UD2 
UD2 - WD( I > 

IF( ABS( WD1-UD2 ) . LE . 180.0)G0 TO 22 
WDf I ) = - WD< I > 

22 CONTINUE 
RETURN 
END 

SUBROUTINE CLOUDCXP.VP) 

COMHON BLOCK 

COMMON ftLT<31).ALl.C0HMftX.C0NCPK.DEGRAD,ADIR,D0SPK,El.CL0HT, 

1DIR<31).I0PT(3)/ITII1E,IDAY,«0NTH(2>/IYEAR,ISTII1,IS0AY, 
ISMOM<2),ISYEAR,IV2,JTOP.JeOT.LAUHTD(10),LTIME.LTIM.LOAY, 
LM0N<2)-LYEAR.LU.NUM,PI.PI0VR2-PI43,PRESS(31 ),PTEMP(31 >, 
SIGHCL.RADDEG,RAT0«CiCLDRAD,R2-R3,SAVEft(30)-SAVER(30)/SIGA, 
SIGX0,SIGX,SPEED(31).SQR2PI,SURDEN,SIG20,SIGAP.S8,TEMP(31), 
TOPSUR.TWOPI,ASPD,VPAR<18>,CRTIME(31).OIST,YES,Y1.NUHRUN, 
YP0S,IFLAG(5),ZB.ZZ.REFLEC.IRETRN 
LOGICAL LTIME 
INTEGER YES 

EQUIVALENCE < Q C 1 , VP AR ( 1 ) ) . < QC 2 , V P A R< 2 ) ) , < Q C3 , V P AR < 3 ) ) , 
<QT1,VPAR(4)).<QT2/VPAR(5)),<QT3;VPAR(6)). 
<AA.VPAR(7)),<BB,VPAR(8)).(CC,VPAR<9))/ 
<HEATN,VPAR(10)),<HEATM.VPAR(ll)).<HEATA,VPARO2)), 
(PHCL,VPAR<13))<<PC0.VPAR<14)),(PC02-VPAR(15))< 
<PAL203.VPAR<16)),(PN0,VPAR<17>),(GAMMAX>VPAR<18)) 

2000 FORMAT CFS. 1 ) 

DIMENSION X< 181), Y< 181 ) 
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RADIUS = GAHHAX * ALT<31) « 0.08 
00 7 1=1,181 

X<I) = RADIUS * C0S<0 . 01745329252 • FL0AT<2 * I)> + XP 
7 Y<I) = RADIUS * SIH(0. 01745329252 * FL0AU2 * D) + YP 
CALL LINE(X, Y, 181 ,0 > 

RADIUS = 5.0 

X< 1 > = XP + RADIUS 

X<2) = XP 

X<3) = XP - RADIUS 
X<4) = XP 
X< 5) = X< 1 ) 

Y< i ) = YP 

Y(2) = YP + RADIUS 
Y<3) = YP 

Y<4) = YP - RADIUS 
Y< 5) = Y< 1 ) 

CALL LIHE(X, Y, 5, 0 ) 

X<2) = XP - RADIUS 
Y<2) = YP 

CALL LINE<X, Y, 2, 0 ) 

X<3) = XP 

Y<3) = YP + RADIUS 
CALL L INE< X( 3 ) , Y< 3 ) , 2, 0 ) 

RETURN 

END 

SUBROUTINE M0VEM<JHD,t1AXJND,HIHJND,LAB,XLABEL,XLIHE,NLINE> 

COHMOH BLOCK 

COMMON ALTC31),AL1,C0NMAX,C0NCPK, DEGRAD, ADIR,DOSPK, El, CLDHT, 

IDIRC31 ), I0PTC3), ITIME,IDAY,M0NTH(2>, IYEAR,ISTIM, ISDAY, 
ISM0N<2), ISYEAR,IV2,JT0P,JB0T,LAUHTD( 10),LTIME,LTrM,LOAY, 
LMON<2),LYEAR,LU,NUN,PI,PIOVR2,PI43,PRESSC31 ),PTEMP(31 ), 
SIGHCL,RADDEG,RAT0MC,CLDRAD,R2,R3,SAVEA(30),SAVER<30),SIGA 
SIGX0,SIGX,SPEED(31),SQR2PI,SURDEH,SIGZ0,SIGAP,S8,TEMP<31) 
T0PSUR,TU0PI,ASPD,VPAR<18),CRTIME<3n,DIST,YES,Yl,NUMRUN, 
YP0S,IFLAG<5),ZB, ZZ,REFLEC,IRETRN 
LOGICAL LTIME 
INTEGER YES 

EQUIVALENCE <QCl,VPAR<i)),(QC2,VPAR<2>),<QC3,VPAR(3)), 
<QT1,VPAR<4)),<QT2,VPAR(5)),(QT3,VPAR<6)>, 
<AA,VPAR<7)),(BB,VPAR<8)),<CC,VPAR(9)), 
<HEATN,VPAR(10)),<HEATM,VPAR(11)),<HEATA,VPAR<12)), 
<PHCL,VPAR<13)).(PC0,VPAR<14)),(PC02,VPAR<15)), 
<PAL203,VPAR<16)),(PH0,VPAR<17)),(GAMMAX,VPAR<18)) 

2000 FORMAT <F6. 1 ) 

2001 FORMAT < " "13" .0" ) 

INTEGER QUES<13),ANS1,ANS2<2),ANS3<4),6LANKS<26) 

DIMENSION LAB<1),XLINE(1>,YLINE(2),JNDALT<3),JNDVAR<3,4) 
EQUIVALENCE <JN0VR1,JNDVAR<1,1)>,(JHDVR2,JNDVAR(1,2)), 
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< JHDVR3i JKDVAR< 1.3) >,( JHDVR4> JNDVAR< 1 .4 > > 

DATA 8UES/2HH0.2HVE.2H .2H .2H 0.2HF . 2HSU . 2HRF . 2HAC > 2HE .2HLA. 

2HYE.2HRf/ 

DATA ANS1/2HUP/. AH S2 /2HD0 . 2HUH/ . ' AHS 3/2HC 0 . 2HH T. 2H I N /2H UE/ 

DATA BLAHKS/26*2H / 

HEHJHD 0 

1 YLIHE<1) = ALT<JND) ♦ 0.08 + 90.0 
YLIHE<2> = YUHE< 1 ) 

00 4 I=1.HLINE 
J = 2 ♦ I - I 

4 CALL LIHE(KLINE< J >. YLINE.2. 0) 

Y = YLINE<1 ) + 2 . 0 

CALL CHAR<460.0i YiO. LAB. 4.2.1 > 

Y = Y - 10. 0 
CALL CODE 

WRITE ( JNDALT. 2000) ALT(JND) 

CALL CHAR<480.0.Y.O.JNDALT.6.2.1) 

CALL CODE 

WRITE ( JNDVRl. 2000) TEHP<JHD) 

YLABEL = PTEHP<JHD) - 273.15 
CALL CODE 

WRITE ( JHDVR2. 2000) YLABEL 
CALL CODE 

WRITE ( JHDVR3. 2000) SPEED<JND) 

CALL CODE 

WRITE ( JHDVR4. 2001 ) IDIR(JND) 

YLABEL = 450.0 
DO 6 1=1.4 

CALL C H AR( XL ABEL. YLABEL. 0. JNDVAR( 1 . 1 >.6.2. 1 ) 

6 YLABEL = YLABEL - 10.0 
RETURN 
END 

SUBROUTINE R WD I S( NA HE . <> J ) 

COHN OH ALT( 31 ).AL1. CONNAX. CONCPK.DEGRAD. ADIR.DOSPK. El. CLDHT. 

IDIR<31 ). I0PT<3>. ITIHE.IDAY.H0NTH<2>. lYEAR.ISTIH. ISDAY. 
ISH0N(2 ). ISYEAR. IV2. JTOP. J60T. LAUNTDCIO ).LTIHE. LTIN. LDAY. 
LN0N<2).LYEAR. LU. NUN.PI. PI0VR2.PI43.PRESS( 31 ).PTEHP( 31 ). 
SIGHCL. RADDEG. RATOnC .CLDRAD.R2.R3. SAVEA< 30 ). SAVER< 30 ). 8IGA. 
SIGXO.SIGX .SPEED< 31 ) .SQR2PI .SURDEH. SIGZO .SIGAP. SB. TENP( 31 ). 
TOPSUR. TWOPI . ASPD. VPARCIB ). CRTINEC 31 ).DIST. YES. Y1 . NUNRUN. 
YPOS. IFLAG<5).ZB.ZZ.REFLEC. IRETRN 
LOGICAL LTINE 
INTEGER YES 

EQUIVALENCE <QC1 . VPARC 1 ) ). <QC2. VPAR< 2 > ) . < QC3 . VPAR< 3 ) ). 

<QT1 . VPAR< 4 ) ). < QT2. VPAR< 5 > ).< QT3. VPAR<6 ) >. 

<AA. VPAR( 7 >).< BB. VPAR< 8) >,( CC. VPAR( 9) >. 

(HEATH. VPAR< 10 ) ). <HEATH. VPAR( 1 1 ) ). ( HEATA. VPARC 12) ) . 
(PHCL.VPARC 13) ).CPCO.VPAR< 14) ),( PC02. VPAR< 15 ) ). 

(PAL203 .VPARC 16 )).( PHO. VPARC 17 )).( GANHAX . VPARC 18) ) 
INTEGER ODCBC 144 ).0BUF<669 ) 
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OIHEHSION HAHE<3) 

EQUIVALENCE < OBUF( 1 ALT< 1 > > 

CALL OPEN(OOCB< lERR.HANE.O > 

IF( J J . EQ. 1 )CALL URl TF( ODCB. lERR. OeUFi 66 9) 
IF( J J . EQ. 0)CALL READF( OOCB , lERR , OBUF < 669 ) 
CALL CLOSE< ODCB< IERR> 

RETURN 

END 

END* 
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FTN4, L 

PROGRAH RCOHC 


C 


CONCEHTRATIOH AND DOSAGE PRDGRAH -- A PROGRAM OF THE 
REED SERIES OF PROGRAMS 


COMHOH BLOCK 


C 

C 

C 


C 


COMHOH ALT<31),AL1jC0HMAX.C0HCPK, DEGRAD, ADIR. DO SPK/EI.CLDHTj 

IDIR(31),I0PT<3)iITIME,IDAY,«0HTH(2>,IYEAR,ISTIMiISDAY, 
ISH0N<2),ISYEAR,IV2,JTPP,JB0T,LAUHTD(10),LTIME,LTIM,LDAY, 
LM0H<2),LYEAR,LU,NUM,PI,PI0VR2,PI43,PRESS(31),PTEMP(31), 
SIGHCL,RADDEG,RAT0MC,CLDRAD,R2.R3,SAVEA(30),SAVER<30),SIGA, 
SIGX0,S1GX,SPEED(31),SQR2PI,SURDEH,SIGZ0,S1GAP,S8,TEMP<31), 
T0PSUR,TU0PI,ASPD,VPAR(18>,CRTIME(31),DIST,YES,Y1,NUMRUN, 
YPOS, IFLAG(5)/28,ZZ,REFLEC, IRETRN 
LOGICAL LTIME 
INTEGER YES 

EQUIVALENCE < QCl , VP AR< 1 ) ), < QC2, VPAR< 2 ) ) , ( QC3 , VPARC 3 ) ) , 
<QT1,VPAR<4))/(QT2,VPAR<5)),(QT3,VPAR(S)), 
<AA,VPAR<7)),(BB,VPAR(8)),(CC,VPAR<9)), 
<HEATN,VPAR<10)),<HEATH,VPAR<lI)),<HEArA.VPAR(I2)), 

< PHCL , VPARC 13 ) ) , ( PCO , VPARC 1 4 ) ) , ( PC02, VP ARC 15 ) ), 
<PAL203,VPAR<16)),(PH0,VPAR(17)),(GAHMAX,VPAR(18)> 

OUTPUT FORMAT STATEMENTS 


200 FORMAT 


201 FORMAT 

202 FORMAT 


203 FORMAT 

204 FORMAT 

205 FORMAT 

206 FORMAT 


<“ 1 “ 1 2X "CLOUD CONCENTRATIONS AND DOSAGES"/ 

"ODI STANCE "4X"C0HCENTRAT I ON "5X "DOSAGE “6X 
"TIME AFTER L AUNCHC SEC ) " / 

“ ( METERS )" 8X"CPP« )"8X"( PPM S EC ) ” 8 X " ST A R T " 3 X " F I H I SH 
<1XF7.1,8XF7.3,8XF7.3,9XF5.1,3XF5.1) 

<//"0**>H*P0INT OF MAXIMUM C ON C EN TR A T I OH ♦ ** * “ / 
6X"RANGE FROM PAD(M): “F8.1/ 

6X"D IRECT ION< DEG ) : "F5.1/ 

6X"HEIGHT(M ): “F6.1/ 

eX’MAXIMUM COHCEHTRAT ION( PPM ) ! "F6.3) 

(//"0**=t:*C0NCENTRATI0NS AND DOSAGES WITH 10 DEGREE " 
"UNCERTAINTIES****" > 

< " 0" 5X" RANGEC M ) ! "F7.1/ 

6X" AZIMUTHC DEG ): "F5.1/ 

6X"MATERIAL"5X”C0NCENTRATI0N(PPM)“11X"00SAGE(PPM)") 
C 4 15 , 12 ) 

< 7X3A2, 6XF8 . 3" +/- " F8 . 3 , 4X F8 . 3 " +/- "F8.3) 


) 
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C TYPE AND DIHENSIOH STATEMENTS 

C 

LOGICAL IGRAF 
INTEGER RIS0P<3> 

DIMENSION FACTC3 >.CMNPL( 3)^ DMNPLC3 >/HATS( 3.5>.NAHE( 3). 

NAHEFC 3 ILINE(32 >< IDATAF< 1 0 ) , I ERS( 32 >. 

DISTVt 81 ),D0SV(81 C0HCV(81 ) 

C 

C DATA STATEMENTS 

DATA NAME/03S522B<2HEE> lH0/iHAMEF/'2H?R, 2HC0. 2HNC/ 

DATA IERS/32*2H / 

C 

DATA FACT/0.0,-0. 174533/0. 174533/ 

DATA MATS/2H /2HHC/2HL ,2H ,2H C/2H0 , 

2H /2HC0/2H2 ,2H A/2HL2/2H03/ 

2H /2H N/2H0 / 

DATA RIS0P/2HRI/ 2HS0/ IHP/ 

CALL GRAF TO INITIALIZE SCOPE (APPROPRIATE ONLY WHEN USING 
PLASMASCOPE ) 

CALL GRAF( 1 ) 

READ COMMON DISK FILE 4REEDD 
CALL RUDI S( NAME/ 0 ) 

IF THIS IS A RESEARCH RUN/ DETERMINE IF PLOTTING IS DESIRED 

IF( IOPTC2 ) . EQ . 0 )G0 TO 55 
C 

CALL DREADC NAMEF , 2/ IL INE ) 

CALL LERS(YPOS) 

CALL CHAR(0. /YPOS.O/ILIN E/42/3/0) 

CALL C' ARC 384. /YPOS/O, ILIHE(25)/8/3/0) 

CALL CHAR<464./YP0S/0.ILINE(30)/6/0/0) 

CALL IH(1/JTYPE/0./0./0/0/0/0/31/0/31/IX/IY) 

CALL CHAR<0..YP0S,0/ILINE/64/0/0) 

IFdX . LE . 25)CALL CH A R( 46 4 . / YP 0 S / 0 / I ER S / 6 / 0 / 0 ) 

IFCIX .GT. 25)CALL CH A R( 38 4 . / YP 0 S / 0 / I ERS / 8 / 0 / 0 ) 

YPOS = YPOS - 32. 

IFdX .LE. 25)IGRAF = .TRUE. 

IFdX .GT. 25)IGRAF = .FALSE. 

C 

C DO LOOP FOR CONCENTRATION AND DOSAGE CALCULATIONS 

C 

C DIST - RANGE FROM STABILIZATION 

C DOSPK - DOSAGE 

C DOSMAX - MAXIMUM DOSAGE 

C CONCPK - CONCENTRATION 
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CONNAX - MAXIHUN CONCENTRATION 


55 NUNV = 
CONNAX 
DOSNAX 
ACTVOL 
TOTVOL 
IF< IV2 

SIGHCL 


0 

* 0.0 
= 0.0 

= PI43 * CLDRAD * CLDRAD * CLDRAO 
= ACTVOL 

.EQ. nACTVOL = PI * <ALT<JT0P> + CLDRAD 
<2.0 * CLDRAD - ALT(JTOP) + 

= SIGHCL ♦ ACTVOL/TOTVOL 


UR ITE <0,200 ) 


DO 59 1=0,20000,250 

HUMV = NUNV + 1 
DIST = 1 

DISTV<HUMV) = DIST 


CALL DFEXP< JTOP, 1000.0) 

DOSPK = SIGHCL * E1/<TU0PI * R2 * ASPD * SQRT<0 
OOSV<HUMV) = DOSPK 

CONCPK = OOSPK ♦ ASP0/<SQR2PI * SIGX) 
CONCV<NU«V) = CONCPK 

DOSNAX = ANAXKDOSPK, DOSNAX) 

IF<CONCPK .LE. CONNAX)GO TO 58 

RATONC = DIST 

CONNAX = CONCPK 

SGXNAX = SIGX 

SGYNAX = SIGY 


58 IF<AHOD<DIST, 1 000 .0 ) . NE . 0.0)C0 TO 59 


ARGl = CRTINEOl) + <DIST - ALl )/ASPD 
ARG2 = CRTINEOl) + <DIST + ALl )/ASPD 
WRITE <0,201) DIST, CONCPK, DOSPK, ARGl, ARG2 


59 CONTINUE 

IF REQUESTED, PLOT THE CENTERLINE DOSAGE AND 
VALUES 

ARGl = ALOGT<DOSNAX ) 
lEXPD = ARGl 

IF<ARG1 .LT. 0.0)IEXPD = lEXPD - 1 
lEXPD = - lEXPD 
ARGl = ALOGT<COHNAX ) 


- ALT< 31 ) )**2 ♦ 
ALT< 31 ) )/3 .0 


. 5 . * R3 )) 


CONCENTRATION 
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lEXPC = ARGl 

IFCARGl .LT. 0.0)IEXPC = lEXPC - 1 

lEXPC = - lEXPC 

IF( . NOT . IGRAF )G0 TO 6 1 

CALL CPL0T< D ISTV/ DOSV . CONCV , NUMV - I EXPD / lEXPC ) 

CALCULATE AND WRITE OUT THE POINT 0 F « A X I MU M • C ON C EH TR A T I ON 

61 ARGl = DEGRAD * ADIR - 
DIST = RATOMC * COS(ARGl)' 

Y1 = RATOMC * SIN< ARGl ) 

DO 62 I=2>JT0P 

IFtCLDHT .LE. ALT<I))GO TO 63 

62 CONTINUE 
I = JTOP 

63 IMl = I - 1 

RANGSR = SAVERdMl) + <CLDHT - ALKIMD) * 

(SAVER(I) - SAVER< IMl ) )/< ALT< I ) - ALT<IM1)) 

ARGl = SAVEACI) - SAVEA(Illl) 

IF<ABS(ARG1) .LT. 180.0)GO TO 66 
IF< ARG 1 , GT . 0 . 6 )GO TO 65 

SAVEA(I) = SAVEAC U + 360.0 
GO TO 66 

65 SAVEA<IM1) = SAVEACIMl) +360.0 

66 AZCS = SAVEACIMl) + ( C tO H T ' - ' AL T C 1 li 1 ) ) * (SAVEACI)i- SAVEACIMl))/ 

CALTCI ) - ALTC IMl )) 

IFCAZCS .GE. 360.0)AZCS = AZCS - 360.0 

ARGl = DEGRAD * AZCS 
X2 = RANGSR •» COSC ARG 1 ) 

Y2 = RANGSR * S INC ARG i )■ ' 

X = DIST + X2 
Y = Y1 + Y2 ;■ 

RNGE = SQRTC X * X + Y * Y) ' 

DIR = RADDEG * ATAN2CY,X) 

IFCDIR .LT. 0.0)DIR = DIR + 360.0 
WRITE C 6. 202 ) RN G E . D I R < Z B ^ C OH M A X 

IF THIS IS A PRODUCTION RUN. SKIP THE OFF CENTER CONCENTATIOM 
SECTION AND THE CALL OF PROGRAM RISOP -- IF PLOTTING WAS HOT 
REQUESTED, JUST SKIP THE OFF CENTER CONCENTRATION SECTION 

IFCIGRAF)GO TO 68 
IFCI0PTC2) .E8. 0)G0 TO 88 
GO TO 81 
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OFF CENTER CONCENTRATIONS SECTION 

68 CALL LABELt lEXPD, lEXPC ) 

ARE OFF CENTER CONCENTRATIONS DESIRED? 

CALL DREADC NAMEF, 3. ILIHE ) 

CALL LERS(YPOS) 

CALL CHARt 0 . . YPOS ,0 , ILINE, 38, 3, 0 ) 

CALL CHAR<384.,YP0S,0>ILINE(25>,8,D,O) 

CALL CHAR(464.,YP0S,0,ILIHE<30>,6,3,0) 

CALL IN(1,JTYPE>0.,0. ,0,0, 0,0, 31, 0,31, IX, lY) 

CALL CH AR<0 . , YPOS ,0 , ILIHE, 64, 0, 0 ) 

IF<IX .LE. 251CALL CH A R( 46 4 . , YP 0 S , 0 , I ER S , 6 , 0 , 0 ) 

IF<IX .GT. 251CALL CH A R( 38 4 . , YP 0 S , 0 , I ER S , 8 , 0 , 0 ) 

YPOS = YPOS - 32. 

IF<IX .GT. 25)G0 TO 81 

OFF CENTER CONCENTRATIONS ARE DESIRED 

UR ITE < 6, 203 ) 

CALL ORGIN< IXSET, lYSET ) 

ARGl = 0.0 

IFCADIR .GT. 180.0)ARG1 = 360.0 
8ETAF = DEGRAD * <180.0 + ARGl - ADIR) 

ARGl = 0.0 

IF<AZCS' .GT. 180.0)ARG1 = 360.0 
BETAS = DEGRAD (180.0 + ARGl - AZCS) 

XP = RANGSR * COS<BETAS) 

YP = RANGSR * SINCBETAS) 

ITER = 0 

LOOP ON OFF CENTER CONCENTRATION REQUESTS 

CALL DREAD< HAMEF , 5, ILI HE ) 

CALL LERS(YPOS) 

CALL CHARCO . , YP0S,0, ILINE, 64, 0, 0 ) 

YPOS = YPOS - 16. 

71 ITER = ITER + 1 

READ IN AND WRITE OUT THE RANGE AND AZIMUTH FOR THE 

OFF CENTER CONCENTRATION CALCULATION -- ENTERING A RANGE OF 0 

TERMINATES THE PROCEDURE 

IFCYPOS .LT. 48. ) YPOS = 458. 
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CALL DREAD< NAMEF, ILINE ) 

CALL LERS< YPOS ) 

CALL CHAR<0.,YPOS,0,ILINE,64.0.0) 

NIN = 7 > ^ 

CALL BLAHK( IDATAF.IO) 

CALL IH<0 , J T YPE. 112 . . YPOSi 0 , IDATAF ,NIN. 0. 31, 0. 31 , IX. I Y ) 

CALL CODE 

READ < IDATAF.* ) RP ' 

IF<RP . LE . 0 .0 )G0 TO 78 
NIN = 7 

CALL BLANKC IDATAF.IO) 

CALL IN<0,JTYPE,272.,YPOS,0,lbATAF,HIN,0,31,0,31,IX,IY> 

CALL CODE 

READ ( IDATAF ,* ) AZP 
YPOS = YPOS - 16. 

IFCYPOS ,LT. 4B.0)YP0S = 458.6 
WRITE ( 6, 204 > RP , AZP 

A R G 1 = 0.0 

IF<AZP .GT. 180.0>ARG1 = 360.0 
AP = DEGRAD ♦ <180.0 + ARGl - AZP) 

XS = RP * COSCAP) 

YS = RP * SIN< AP ) 

ON THE PLOTTER, WRITE OUT AN ASTERISK AND THE ITERATION 
NUHBER AT THE LOCATION WHERE THE OFF CENTER CONCENTRATION 
CALCULATION IS DESIRED 

IX = IXSET + 0.2631 ♦ XS 
lY = I YSET + 0.3545 • YS 
WRITE <L2 ) -1, 1, IX, lY 
CALL SYMBLC 100, 125, IH* ) 

IX = IX + 75 

WRITE < 12 ) -1, 1, IX, lY 

WRITE < 12,205) 1 0 0 , 0 , 0 , 1 25 , I T ER 

CALCULATE THE CONCENTRATIONS AND DOSAGES AT THIS POINT PLUS 
10 DEGREES UNCERTAINTIES ON EITHER SIDE 

XHAT = XS - XP 
YHAT = YS - YP 

DO 74 1=1 ,3 

ARGl = BETAF - FACT< I ) 

Y = - XHAT # SIN<ARG1) + YHAT • C0S<ARG1) 

DIST = XHAT * C0S<ARG1) YHAT * SIN<ARG1) 

CALL DFEXP< JTOP, 1000. 0 ) 

DOS = SIGHCL ♦ El • EXP<- Y • Y/<2.0 ♦ R2 * R2 ) )/ 

<TWOPI * R2 * ASPD * SQRT<0.5 ♦ R3)) 

CONC = DOS * ASPD/<S8R2PI * SIGX) 
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<QTl,VPAR<4)).<QT2,VPftR<5))i<QT3,VPAR<6)), 

( AA. VPflR( 7 >)i< BB, VPAR< 8 ) ) , ( CC / VPAR< 9) ), 

(HEATH, VPAR< 10 ) ), (HEATH, VPAR< I 1 ) ), < HEATA, VPAR< 12) ), 
(PHCL,VPAR( 13) ),(PC0,VPAR( 14) ) , ( PC0 2, VP AR( 15 ) ), 
(PAL203 . VP AR( 18 ) ) .( PHO , VPAR( 1 7 )), ( GAHHAX, VPAR( 1 8 ) ) 
IHTEGER 0DCB(144 ),0BUF(889) 

OIHENSIOH NAHE(3) 

EQUIVALENCE ( 0BUF( 1 ), ALT< 1 ) ) 

CALL 0PEN(0DCB, IERR,NAHE,0 ) 

IF( J J . EQ. 1 )CALL URITF(ODCB, IERR,0SUF,889) 

IF(JJ .EQ.0)CALL R E A DF ( OD CB , I E RR , OB UF , 88 9 ) 

CALL CLOSE( ODCB, lERR) 

RETURN 

END 

SUBROUTINE CPLOT<OISTV,DOSV.CONCV,HUMV,IEXPD,IEXPC) 


THIS SUBROUTINE PLOTS THE DOSAGE AND CONCENTRATION CENTERLINE 
CURVES 


COHHON BLOCK 

COMHON ALT(31),AL1,C0HMAX,C0NCPK,DEGRAD,ADIR,00SPK,E1,CLDHT, 

IDIR(3I),I0PT<3),ITIHE,IDAY.H0NTH<2),iyEAR,ISTIM,ISDAY, 
ISM0N<2),ISYEAR,IV2,.JT0P,JB0T,LAUHTD(10),LTIME,LTIM,LDAY, 
LH0N(2),LYEAR,LU,NUM,PI,PI0VR2<PI43,PRES3(31),PTE«P(31), 
SIGHCL,RADDEG,RATOMC,CLDRflD,R2,R3,SAVEA<30),SAVER(30),SIGA, 
SIGX0,SIGX,SPEED(31),SQR2PI,SURDEN,SIGZ0,SIGAP,S8,TEMP(31), 
T0PSUR,T«0PI,ASP0,VPAR(18>,CRTIME(31),DIST,YES,Y1,NUHRUN, 
YP0S,IFLAG(5),2B,ZZ,REFLEC,IRETRN 
LOGICAL LTIHE 
INTEGER YES 

EQUIVALENCE (QC1,VPAR(1)),(QC2,VPAR(2)),(QC3,VPAR(3)>, 
<QT1,VPAR(4)),(QT2,VPAR<5)),(QT3,VPAR(8)), 
(AA,VPAR<7)),(BB,VPAR<8)),(CC,VPAR(9)), 
(HEATN,VPAR(10)), (HEATH, VPAR(11)),<HEATA,VPAR(12)), 
(PHCL , VPAR< 1 3)),(PC0,VPAR(14)),(PC02,VPAR(15)), 
(PAL203iVPAR(I6)),(PN0,VPAR<l?)),(GAHHAX,VPAR<18)) 

DIMENSION STATEMENT 

DIMENSION DI ST V< 1 ), DOSVC 1 ), CONCV( 1 ) 

CALCULATE PLOTTING FACTORS 

FDIST = 9295 . OZ30000 . 0 
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FDOS = 8231.0 * 10.0**<IEXPD - 1) 

FCOHC = 8231.0 * 10.0**(IEXPC - 1) 

PLOT THE. DOSAGE CEHTERLIHE CURVE 

DO 7 I=1,NUMV 

IX = DISTVCI) ■* FDIST + 725.0 
lY = D0SV<I) * FDOS ♦ 1040.0 
WRITE ( 12 ) -I, 1, IX, lY 
7 CALL SYMBL< 100,100,254008) 

PLOT THE CONCENTRATION CENTERLINE CURVE 

DO 16 I=1,NUHV 
J = 1/1 
J = 1 - 2 ♦ J 

IX = DISTV<I) * FDIST + 725.0 
lY = CONCVCI) * FCONC + 1040.0 
16 WRITE (12) J,1,IX,IY 

RETURN TO RCONC 

RETURN 

END OF 'CPLOT 


END 

SUBROUTINE L AB EL ( I E XPD , I EX P C ) 


THIS SUBROUTINE LABELS THE CONCENTRATION AND DOSAGE CENTERLINE 
PLOTS 




COHHON BLOCK 

COMMON ALT(31),AL1,C0NMAX,C0NCPK, DEGRAD, ADIR, DO SPK, El, CLDHT, 

IDIR(31),I0PT(3),ITIME,IDAY,M0HTH(2),IYEAR,ISTIM,ISDAY, 
ISMON(2),ISYEAR,IV2,JTOP,JBOT,LAUNTD(10),LTIME,LT1M,LDAY, 
LMON( 2 ) , LYEAR, LU, NUH , P I, P I0VR2 , P 143 , PRESS( 31 ) ,PTEMP( 31 >, 
S1GHCL,RADDEG,RAT0MC,CLDRAD,R2,R3,SAVEA<30),SAVER(30),SIGA, 
SIGX0,SIGX,SPEED(3i ),SQR2P1,SURDEH,SIGZ0,SIGA>,S8,TEI1P(31 ), 
T0PSUR,TW0PI,ASPD,VPAR(18),CRTIHE<31),DIST,YES,Y1,NUMRUN, 
YPOS, IFLAG(5),ZB,ZZ,REFLEC, IRETRN 
LOGICAL LTIME 
INTEGER YES 

EQUIVALENCE < 8 C 1 , VP AR ( 1 > ) , < QC 2 , V P A R< 2 ) > , ( 8 C3 , V P AR < 3 ) ) , 
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<QT1 , VPAR< 4) <QT2, VPAR< 5 >)>< QT3, VPARC6 ) )i 

<AA. VPAR< 7 )),<BB<VPAR( 8) ).(CC, VP-AR< 9) )/ 
(HEATN,VPAR<10)),<HEATM,VPAR<11)).<HEATA,VPAR<12)). 
<PHCL . VPAR< 1 3 ) ),( PCO. VPAR( 1 4 ) > , ( PC02. VPAR< 15 ) ), 

< PAL2 03 . VPAR( 16 )>i( PNO, VPAR< 1 7 > ) , < GAMMAX . VPAR< 13) ) 

OUTPUT FORMAT STATEMENTS 

200 FORMAT <415, 12 ) 

' 201 FORMAT <415. F5 .0 ) 

202 FORMAT <415. F5. 2) 

203 FORMAT < 4 1 5 . 1 4 . 1 X A 1 . A 2 . 2 XI 2 . 1 X A 2 . A 1 . 1 X I 4 > 

204 FORMAT <415. 14" C * A 2 . 2 X I 2 . 1 XA 2. A 1 . 1 X I 4 ) 

205 FORMAT < 4 1 5 . 1 4 , 1 X R 1 . A 2 . 2 X I 2 . 1 XA2 . A 1 . 1 X I 4 ) 

LABEL THE PLOT 



I = - lEXPC 

WRITE < 12) -1. 1.300.5000 
WRITE <12.200) 0. 150. -100.0. I 
I = - lEXPD 

WRITE < 12 ) -1.1. 300.6500 

WRITE <12,200) 0. 150. -100.0. I 

WRITE < 12 ) - 1 . 1. 3700. 8950 

WRITE <12.201) 1 25. 0. 0, 1 25 . CLDHT 

WRITE < 12) -1. 1.3700.8745 

WRITE <12.201) 1 25. 0. 0 . 1 25 . CRTIME< 31 ) 

WRITE < 12 > - 1 . 1 .3700.8540 

WRITE <12.202) 1 25. 0. 0 . 1 25 . CONMAX 

WRITE <12) -1.1. 3700. 8335 

WRITE < 12.20 1 ) 1 25. 0. 0 , 1 25 . ALT< J TOP ) 

WRITE < 12 ) -1.1.3700.8130 
WRITE <12.201) 125. 0.0. 125. ZB 
WRITE < 12) -1. 1.3700,7925 
WR ITE < 12 . 20 1 ) 1 25. 0. 0 , 1 25. ZB 
IF< IOPT< 1 ) , EQ . 1 >G0 TO 4 
WRITE < 12 ) -1.1. 5625,8980 
WRITE <12) 1.1.6125.8980 
GO TO 7 

4 WRITE <12) -1.1.5025.8980 
WRITE < 12 ) 1 . 1 .5525.8980 
WRITE < 12) -1. 1,5725.8950 

WRITE <12.203) 125.0.0.125.ISTIM.IFLAG<4).LAUHTD<4),ISDAY.ISMON. 

I SYEAR 

7 WRITE <I2) -1.1.5725.8695 

WRITE < 12.204 ) 1 2 5 . 0 . 0 , 1 25 . 1 T I M E . L AU N TD < 4 ) , I 0 A Y . H OH T H , I Y E AR 
WRITE < 12 ) - 1 . 1. 5725. 8490 

IF<LTIME)WRITE < 12.205) 125.0,0. 125.LTIM.LAUNTD<3).LAUNTD<4).LDAY. 

LMON. LYEAR 
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C RETURN TO RCOHC 

c 

RETURN 

END OF LABEL 

END 

SUBROUTINE DFEXP( J > COHC ) 


THIS SUBROUTINE CALCULATES DIFFUSION EXPONENTIALS 

J - INDEX IN THE ALT ARRAY OF THE TOP OF THE LAYER 
CONC - CONCENTRATION TO BE TESTED 


COHHON BLOCK 

CONN OH ALT< 31 ) i AL 1 < CO H MAX. C OH CP K , D EG R AD , A D I R , D 0 8P K / E 1 ^ CLDHT , 

IDIR< 31). I0PT< 3 >. ITIME. IDAY ,M0NTH< 2 ). lYEAR. ISTIM, ISDAY. 
ISM0H<2 ). ISYEAR. IV2. JTOP. JBOT. LAUNTDI 10 ).LTIME.LTIM. LDAY, 
LM0H<2).LYEAR.LU.NUM.PI.PI0VR2,PI43.PRESS(31>,PTEMP<31). 
S1GHCL.RADDEG.RAT0HC.CLDRAD.R2.R3. SAVEAC 30). SAVER! 30>.SIGA. 
SIGX0.SIGX.SPEED(31).SQR2PI.SURDEN.SIGZ0.SICAP.S8.TENP(31>. 
T0PSUR.TH0PI,ASPD.VPAR<18).CRTIME(31).DIST.YES.Y1,NUMRUN. 
YPOS. IFLAG<5).ZB.Z2.REFLEC. IRETRN 
LOGICAL LTIME 
INTEGER YES 

EQUIVALENCE CQC1,VPAR<1)).<QC2.VPAR(2)),(QC3.VPAR(3)). 

<QT1,VPAR(4)).(QT2.VPAR<5)).<QT3.VPAR<6)>. 
<AA.VPAR<7)),(BB.VPAR<8)).(CC.VPAR<9)), 
<HEATN.VPAR<10)).<HEATM.VPAR(11)).(HEATA.VPAR<12)). 
<PHCL . VPAR< 13) ).< PCO, VPAR< 14 ) ) . < PC02. VPAR< 15 ) ). 
<PAL203.VPAR(16)).(PH0.VPAR(17)).(GAHMAX.VPAR(18)> 


CALCULATE SIGMA Z 

SIG2 = DIST * SIGAP + SIGZO/1.28 
R3 = 2.0 * SIGZ * SIGZ 

CALCULATE THE EXPONENTIAL SUM IN THE DIFFUSION EQUATION 

TWOI = 2.0 
ZT = ALT<J) 

TEMP2 = CLDHT - ZZ 

TEMPS = CLDHT - 2.0 ♦ ZB + ZZ 
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El = EXP< - TEHP2 ♦ TE«P2-'R3) + 

EXP< - TEMP3 * TEMPS/RS) 

4 TEMPI = T«0I * (ZT - ZB) 

TEXPSM = El 

TEXP = (TEMPI - TEMP2)**2/R3 

IFCTEXP .LE. 120.0)E1 = El + EXP< - TEXP) 

TEXP = (TEMPI + TEMP2)**2/R3 

IF(TEXP .LE. 120.0)E1 = El + EXP( - TEXP) 

TEXP = (TEMPI - TEMP3 )**2<^R3 

IF(TEXP .LE. 120.0)E1 = El + EXP( - TEXP) 

TEXP = (TEMPI + TEMP3 )*i‘2/R3 

1F(TEXP .LE. 120.0)E1 = El + EXP( - TEXP) 

IF(E1 .EQ. TEXPSM)GO TO 7 
TUOI = TWOI + 2.0 
GO TO 4 

7 El = REFLEC * El 

CALCULATE SIGMA Y 
SB = D!ST * SIGAP * SIGXO 

R2 = SQRT(S8 ♦ SB + ( 0.0040589 * F LO A T( 1 0 1 R( J ) - IDIR(D) * 

DIST)**2) 

CALCULATE CLOUD LENGTH 

TEMPI * SPEED( J ) - SPEED( 1 ) 

ALl = 0.28 * TEMPI *OIST/ASPD 
IF(TEMP1 .GE. 0.0)GO TO 11 
IF(PTEMP( J )-PTEMP( 1 ) . GT . 0.0)AL1 = 0.0 
ALl s ABS/ALl) 

CALCULATE SIGMA X 

11 SIGX = SQRT( (ALl/4. 3)**2 + SIGXO * SIGXO) 

IF C0NC=1000.0. DO NOT CALCULATE CROSS WIND DISTANCE BUT RETURN 
TO THE CALLING PROGRAM 

IF(CONC .Efi. 1000 .0 )RETURN 

CALCULATE CROSS WIND DISTANCE 


Yl 

Y1 


- 2.0 • R2 * R2 * AL0G(15.7496 * CONC * SIGX * R2 • 

SIGZ/C SIGHCL * El )) 


SQRT(AMAX1( Yl. 0. 0 )) 


RETURN TO THE CALLING PROGRAM 


RETURN 

C 
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C 

C 


END OF DFEXP 


END 

SUBROUTINE ORG I N ( I X 0 . I YO } 



THIS SUBROUTINE GIVES THE ftPPROPR I ATE COORD I NATES FOR PLOTTING 
FOR THE COMPLEX AND MAP SELECTED 


COMMON BLOCK 


COMMON ALT<3n.ALl.C0HMAX,C OH CPK, DEGRAD iADIR.OOSPK. El. CLDHT, 

IDIR<31 ). IOPT<3).ITIME.IOAY,MOHTH<2). lYEAR.ISTIM. ISOAV. 
ISH0N(2).ISYEAR,IV2.JT0P,JB0T.LAUNTD(10).LTIME.LTIM.LDAY, 
LMON(2).LYEAR,LU.NUM.PI.PI0VR2,PI43.PRESS(31),PTEMP<31). 
SIGHCL.RADDEG.RATOHC/CLDRAD,R2,R3.SAVEA(30).5AVER(30).SIGA. 
SIGX0.SIGX,SPEED(31).SQR2PI.SURDEN.SIGZ0.SIGAP.S8.TEMP<31>. 
T0PSUR.TW0PI.ASPD.VPAR<18).CRTIME<31).DIST.YES.Y1.NUMRUN, 
YPOS. IFLAG(5).2B.ZZ,REFLEC. IRETRN 
LOGICAL LTI ME 
INTEGER YES 

EQUIVALENCE (QC1.VPAR(1)).<QC2.VPAR<2)).(QC3 . VPAR( 3 ) >, 

< 8T1 . VPAR< 4 ) ). ( QT2. VPAR< 5 > ) . < QT3 . VP AR( 6 ) ). 

< AA. VPAR< 7 ) )i < BB. VP ARC 8 ) ) ,< CC. VPAR< 9 ) ). 
<HEATN.VPAR<10)).<HEATM.VPAR<11))><HEATA,VPAR<12)). 
CPHCL.VPAR<13)).<PC0.VPAR(14)).CPC02.VPAR<i5)). 
<PAL203,VPAR<16)),(PN0.VPAR<17>).<GAMMAX,VPAR<:i8)) 
DIMENSION ILINE<32).IDATAF<10>.IERS<32).IMAPL(48).NAMEF(3) 


INPUT FORMAT STATEMENT 
100 FORMAT ( 12/ IXAl ) 

OUTPUT FORMAT STATEMENT 


TYPE AND DIMENSION STATEMENTS 

LOGICAL NOTiST 
DIMENSION IX<8>/IY(8) 

DATA STATEMENTS 

DATA IERS/32x>2H / 

DATA NAMEF/2H7R/ 2HI S/ 2H0P/ 

DATA IMAPL72H40/2H.S/2HEA/2H M/2HAP/2H 
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1 2H40. 2H/L.2HAH.2HD .2HHA.2HP , 

1 2H41. 2H, S/2HEA. 2H H.2HAP,2H . 

1 2H41, 2H, L. 2HAN. 2HD .2HNA.2HP . 

1 2H17.2H.S.2HEA.2H H,2HAP.2H . 

1 2H17. 2H. L/2HAH/2HD .2HHA/2HP . 

i 2H39. 2H. S/ 2HEA. 2H M.2HAP,2H . 

1 2H39. 2H. L. 2HAH. 2HD .2HMA.2HP / 

DATA NOTIST/ .FALSE. // LCHAR/IHL/ 

DATA I X/5450 , 5 41 1 ,4830 . 4825,8 750,8 730 ,4100,4 100/ 

DATA IY/2 630, 8 24 3, 2 46 5, 805 0,2 99 0,8600, 1700,7300/ 

IS THIS THE FIRST TIME THROUGH THIS SUBROUTINE? -- 
IF NOT, IT IS NOT NECESSARY TO CALCULATE THE INDEX OF THE 
COORDINATES, I, AGAIN 

IF<N0T1ST)G0 TO 7 

THIS IS THE FIRST TIME THROUGH -- READ IN THE COMPLEX NUMBER 
AND THE DESIRED MAP, i.e. SEA OR LAND 

NOTIST = .TRUE. 

CALL DREAD(NAHEF,7, ILINE) 

CALL LERS< VPOS ) 

CALL CHAR<0 . , YP0S,0, ILINE, 6 4, 0, 0 ) 

YPOS * YPOS - 16. 

IF< YPOS .LT. 48. ) YPOS = 458. 

IF< IOPT< 3 ) . EQ . 1 ) CALL DREA D < N AH E F , 8 , I L I NE ) 

IF< I0PT<3 ) . EQ . 2 ) CALL DREADC N AMEF, 9, I LI NE ) 

IF( I OPT< 3 ) . EQ . 0 ) CALL DR EA D( N AM E F , 1 0 , I L I N E ) 

CALL LERS(YPOS) 

CALL CHAR<24.,YPOS,0,ILINE(2),8,3,0) 

CALL CHAR<95.,YP0S,0,ILINE(7),50,0,0) 

CALL IN(l,JTYPE,0.,0.,0,0,0,0,31,0,3l,IXC, lYC) 

CALL CHAR<0 . ,YP0S,0,IERS,64,0,0 ) 

CALL CH AR <200., YPOS +16,0, IE RS, 25, 0,0) 

IF< IXC . LT .6 . AND . I OPTC 3 > . EQ . 1 ) 1 = 1 

IF<IXC.GT.5.AND.IXC.LT.12.AND,I0PT(3).EQ.1> 1=2 

IF< IXC . GT . 1 1 . AND . IXC . LT. 18 . AND . IOPT< 3 ). EQ . 1 ) 1=3 

IF<IXC.GT.17.AND. I0PT<3).EQ.l ) 1=4 

IF( IXC . LT .6 . AND. IOPT< 3 ). EQ . 2) 1=5 

IF< IXC . GE .6 . AND . lOPTC 3 ).EQ . 2) 1 = 6 

IF( IXC . LT .6 . AND . I OPT( 3 ). EQ . 0) 1 = 7 

IF( IXC . GE .6 . AND . IOPT< 3 ). EQ . 0) 1=8 

IMP = ( I - 1 )*6 + 1 

CALL CHAR< 208., YPOS + 16 ,0, IMA PL (IMP), 12, 0,0) 

YPOS = YPOS - 16. 

IF< YPOS . LT . 48 . ) YPOS = 458 . 

SET THE COORDINATES BASED OH THE INDEX I 
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7 IXO * IX< I) 
lYO « IY< I) 

RETURN TO THE CALLING PROGRAN 
RETURN 

END OF ORGIN 

END 

SUBROUTINE SYHBL( lU IDE . INI . ISYHB > 

IX—IUIDE/2 
IY»-IHI/2 

«RITE< 12) -1 ,-1/ IX/ lY 
URITE( 12/100) lUIDE/O/O/IHI/ISYNB 
100 F0RHATC4I5/A1/ IH- ) 

IY=-IY 

«RITE< 12)-1 / -1 / IX. I Y 

RETURN 

END 

SUBROUTINE D RE AD ( HA HE F . L NU N . I L I N E ) 

D I HENS I ON NAMEF< 3 )/ IDCB< 276 )/ IBUF< 40 )/ ILIHE( 32 )/ IPAR< 5 > 
CALL RHPAR< IPAR) 

LU = IPARU) 

CALL OPEH<IDCB/IERR/HANEF/0) 

LOOP * LNUM - 1 
00 10 1=1 /LOOP 
CALL BLANKS IBUF. 40) 

CALL READFC IDCB/ lERR/ IBUF) 

10 CONTINUE 

CALL BLANK( IBUF/40) 

CALL READF( IDCB/ lERR/ IBUF) 

CALL CODE 

READ< IBUF/ 100) < I LI HE< I ) / I = 1 . 32 ) 

100 F0R«AT(32A2) 

CALL CLOSE( IDCB. lERR) 

RETURN 

END 

SUBROUTINE BLANX( IBUF . 1 1 ) 

DIHENSIOH IBUF<40) 

DATA IBLK/2H / 

DO 10 1=1/11 
10 IBUF< I ) = IBLK 
RETURN 
END 

SUBROUTINE LERS(YPOS) 

DIHENSION IERS(32> 

DATA IERS/32*2H / 

IF(YP0S.LE.48) YPOS = 458.0 
CALL CHAR<0 . / YPOS/0/ IERS/64, 0/ 0 ) 
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CALL CHAR(0.,YP0S-l£./0.IERS.64^0/0> 

RETURN 

END 

END* 
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PROGRAM RISOP 
C 


ISOPLETH PLOTTING PROGRAM -- A PROGRAM IH THE REED SERIES 
OF PROGRAMS 


COMMON BLOCK 

COMMON ALT<31).AL1jC0NMAX^C0NCPK.DEGRAD.ADIR^D0SPK/E1.CLDHT. 

IDIR<31).I0PT<3).ITIME.IDAY,H0NTH<2).IYEAR,ISTIM,ISDAY, 
ISMON<2)/ISYEAR,IV2,JTOP,JBOT,LAUNTD(10),LTIME,LTIM.LDAY/ 
LM0N(2).LYEAR.LU,HUM,PI,PI0VR2,PI43,PRESS<31).PTEMP(31)i 
SIGHCL.RAD0EG.RArOMC,CL0RAD,R2,R3.SAVEA<3O).SAVER<3O).SIGA. 
SIGX0,SIGX.SPEED<31),SQR2PI,SURDEN,SIG20,SIGAP,S8,TEMP<31), 
TOPSUR,TWOPI,ASPD,VPAR(I8),CRTIME<31),OIST,YES/Y1,NUMRON, 
YPOS. IFLAG<5 2B. 2Z, REFLEC. IRETRN 
LOGICAL LTIME 
INTEGER YES 

EQUIVALENCE < Q C 1 , VP AR < 1) > , ( QC 2 . V P A R< 2 ) ) , < Q C3 . V P AR < 3 ) > , 

<QT1 , VPAR< 4 ) >. < QT2, VPAR< 5 )).< QT3. VPAR<6 ) ). 

(AA,VPARC7)),<BB.VPAR<8)),<CC,VPAR<S>), 

<HEATN,VPARC10)),(HEATM.VPAR(11)),<HEATA,VPARC12)), 

< PHCL < VPARC 1 3 ) > i ( PCO , VPARC 14 ) ). ( PC02. VPAR< 15 ) ), 

<P AL203 , VPARt 16 ) ) , < PNO / VPAR< 1 7 ) )/ ( GAMMAX , VPAR( 1 8 ) ) 

OUTPUT FORMAT STATEMENTS 


200 FORMAT 


201 FORMAT 

202 FORMAT 

203 FORMAT 

204 FORMAT 

205 FORMAT 

206 FORMAT 

207 FORMAT 

208 FORMAT 


(" 1 "20X “CLOUD LOCATION AND DIMENSIONS"/ 

■■ TIME FROM CLOUD S T A B I L I Z AT I ON " 5 X " R AH G E " 5X " AZ I M U TH “ 
SX'DIAMETERS <METERS)*/ 

1 IX “<MINUTES)"14X"< METERS )“4X“< DEG >"6X“CR0SS HIND" 
4X"AL0NG HIND* ) 

(12XF6.2/16XF8.1MXF5.1,7XF7.1i7XF7.1) 

<4I5>I4" C*A2/2XI2/ 1XA2. All 1XI4> 

<415/ A1 > 

<415. F5 ,2"_" ) 

<4I5". "F5.2“_“) 

<F5. 3 > 

< 1 1 ) 

<4I5>I4/1XR1/A2>2XI2.1XA2/A1/1XI4> 


TYPE AND DIMENSION STATEMENTS 
LOGICAL DFALTC 

DIMENSION CONC< 10 )/ NAME< 3). NAMEF< 3 )/ ILIHE< 32 >/ IDATAF< 10>. 


A-141 


u U U oi oouuuuu uoou ouuo uuu 


IERS<32>. iXA( 100 I YA( 100>, IXB( 100 >> I YB<iOO> 

DATA HAHE/03AS22B»2HEEi 1HD/«NAKEF/2H?R<2HIS/^H0P/ 

DATA IERS/32*2H / 

CALL GRAF TO INITIALIZE SCOPE (APPROPRIATE ONLY UHEN USING 
PLASNASCOPE) 

CALL GRAFCl > 

READ COHHOH DISK FILE 

CALL RUDIS(NAHE/0 > 

DETERHIHE THE ORIGIN OH THE HAP FOR THIS PLOT AND HOVE THE 
PEN THERE 

CALL 0RGIH( IX0> lYO) 

HRITE < 12 ) -1/ 1, IXO , I YO 

DETERHIHE THE IHDEX IN THE ALTITUDE DATA ARRAY THAT HAS 

THAT ALTITUDE JUST LOWER THAH THE EFFECTIVE CLOUD HEIGHT, CLDHT 

DO 4 I=2,JT0P 

IF<CLDHT .GT. ALT<I))GO TO 4 
ICLDHT =1-1 
GO TO 5 

4 CONTIHUE 
ICLDHT = JTOP 

DRAW THE LINE DEPICTING CLOUD HOVEHENT ALONG THE GROUND 
AS FAR AS THE CLOUD STABILIZATION POINT 

5 X = 0. 0 

Y = 0. 0 

DO 9 1=2, ICLDHT 
IHl = I - 1 

RANGE = 0.5 ♦ <CRTIHE(I) - CRTIHE(IHl)) ♦ <SPEED<I) + SPEED(IHl)) 
DIR = 0.5 * FLOAT< IOIR< I ) + IDIR(IHl)) 

IF( I ABS< IDIR< I ) - IDIR(IMl)) .GT. 180)DIR = DIR - 180.0 
IF<DIR .LT. 0.0)DIR = DIR + 360.0 
DIR = DEGRAD * <360.0 - DIR) 

X = X + RANGE COS<OIR) 

Y = Y + RANGE * SIN<DIR) 

IX = INT< 0. 2631 * X ) + IXO 
I Y = I NT( 0 . 3545 ♦ Y ) + I YO 

IFdX.LT.O .OR. IX. GT. 9899 .OR. lY.LT.O .OR. I Y . GT . 9999 )G0 TO 11 
9 HRITE ( 12 ) 1 , 1 , IX , I Y 

HAKE THE CALCULATIONS NECESSARY TO WRITE OUT THE CLOUD 
LOCATION AND DIHENSIONS 
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c 

11 flLTl * 0.5 • (CLDHT + ALTCICLDHT)) 

ICLOPl a ICLDHT +1 

ARGl * ALKJCLDPl) - ALTCICLDHT) 

ARG2 * CCLDHT - ALT C I C LD HT ) >/ AR G 1 

SPCENT * SPEEDC ICLDHT ) + < SPEEDC ICLDP 1 ) - SPEEDC I CLDHT ) ) ♦ ARC2 
RAHGE * SPCENT * < CRT I NEC I CLDPl ) - C R T I HEC I C LD H T ) ) * ARG2 
IFC I ABSC IDIRC ICLDPl ) - I D I R< I CL D HT > ) .LT. 180)G0 TO 14 
IFC IDIRC ICLDPl ) .LT. 1 80 ) 1 D IR C I C LO HT > = IDIRCICLDHT) + 360 
IFC IDIRC ICLDHT ) . LT . I 80 >I D IRC I CLDHT ) = IDIRCICLDHT) + 360 
14 DIR = FLOATC IDIRC ICLDHT > > + CALTl - ALTCICLDHT)) * 

FLOATC IDIRC ICLDPl ) - I D I RC I CL DH T ) )/AR G1 
IFCDIR .GT. 360.0)0IR = DIR - 360.0 
IFCDIR .GT. 180.0)G0 TO 17 
DIR = DIR + 180.0 
GO TO 18 . 

17 DIR = DIR - 180.0 

18 DIR = 180.0 - DIR 
ARGl - DEGRAD * DIR 

X = X + RANGE * COSC ARGl ) 

Y = Y RAHGE * S IHC ARGl ) 

R = SQRTCX ♦ X + Y * Y) 

DELR a 300.0 * ASPD 
C 

OACRS = 4. '30 * SIGXO 
DALNG a 4.30 * SIGXO 
C 

ARGl = 180.0 

IFCDIR .GT. 180.0)ARG1 = 540.0 
AZ = ARGl - DIR 
C 

ARGl = 180.0 

IFCADIR .GT. 180.0)ARG1 = 540.0 
0A2 = ARGl - ADIR 
ARGl a DEGRAD * DAZ 
DELX a DELR * COSC ARGl ) 

DELY a DELR * SINC ARG 1 > 

C 

DELU a ABSC SPEEDC ICLDHT ) - SPEEDCl)) 

C 

DELTH a IDIRCJTOP) - IDIRCl) 

C 

TIM a 0.0 
R1 a 0.0 
XC a X 

YC a Y 

TXL a 0.28 * DELU/ASPD 
SIGX02 a SIGXO * SIGXO 
S82 a S8 ■» S8 
WRITE C 6. 200 > 
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DO 22 I=>1,13 

yRITE (6.201) T1H,R<AZ.DACRS>DALNG 
TIH = TIM + 5.0 
R1 R1 -I- DELR 

XL = R1 • TXL 

SIGX a SQRT<<XL/4.30)**2 + SIGX02) 

DACRS > 4.30 * SIGX 

SIGY * SQRT<S82 + <0.0040589 - 3.0 * DELTH * Rl)**2) 

DALMG =: 4.30 * SIGY 

XC = XC + DELX 

YC = YC + DELY 

R = SQRKXC * XC + YC * YC) 

22 AZ = 180.0 - RAODEG * ATAM2<YC,XC) 

LABEL THE CLOUD STABILIZATION POINT WITH A + 

IX = INT< 0.2631 * X ) + IXO 
I Y = INT< 0 . 3545 ♦ Y ) + I YO 

IFdX.LT.O .OR. IX. GT. 9999 OR. lY.LT.O .OR. I Y . GT . 9999 )G0 TO 77 
IXX = IX 
lYY = lY 

URITE < 12 ) 1 , 1 i IX, lY 
CALL SYHBL( 150,150, 1H+ ) 

LABEL THE POINT OF MAXIMUM CONCENTRATION WITH A 0 

DIR = DEGRAD ♦ <180.0 - ADIR) 

CDIR a COS<DIR) 

SDIR = SIN< DIR ) 

IXl = INT<0.2631 * <X + RATOMC * CDIR)) + IXO 

lYl = INT<0.3545 ♦ <Y + RATOMC * SDIR)) + lYO 

URITE < 12 ) -1, 1, 1X1 , lYl 
CALL SYMBL< 1 50,150, 1H0 ) 

DRAU THE LINE OF CLOUD MOVEMENT ALONG THE GROUND FROM 
THE CLOUD STABILIZATION POINT ON 

URITE < 12 ) -1, 1, IXX, I YY 
RANGE = 1000.0 
27 X = X + RANGE * CDIR 

Y = Y + RANGE * SDIR 

IX = INT<0.2631 * X ) + IXO 
lY = INK 0. 3545 * Y ) + I YO 

IF<IX.LT.O .OR. IX. GT. 9999 OR. lY.LT.O OR. I Y . GT . 9999 )G0 TO 29 
WRITE < 12 ) 1 , 1 , IX , I Y 
GO TO 27 

29 URITE < 12) -1, 1, IXX,IYY 
C 

C ARE DEFAULT CONCENTRATION VALUES GOING TO BE USED 
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C FOR THE PLOTS 

C 

IF<YPOS.LT.48. ) YPOS = 458. 

CALL DREAD(NAHEF,2/ ILIN£> 

CALL LERS(YPOS) 

CALL CHAR<0. ,YP0Si0,ILIHE,64,0,0) 

YPOS = YPOS - 16. 

CALL DREAD<NAHEF>3. ILINE> 

CALL LERS<YPOS) 

CALL CHAR<0 . , YPOS,0,ILIHE, 64, 0, 0 ) 

YPOS = YPOS - 32. 

C 

C YES — SET UP THE DEFAULT VALUES 

C 

CONC< I ) = 0.1 * COHHAK 
C0HC<2) = 0.5 * COHHAX 
C0NC<3) = 0.75 * CONMAX 
C0HC<4> = - 1.0 
CALL CODE 

WRITE <IDATAF/206) CONCCl) 

CALL CHAR<440. ,YP0S+48.,0, IDATAF,5,0,0) 

CALL CODE 

WRITE <IDATAF,206> C0NC(2) 

CALL CHAR< 120. , YPOS + 32 . , 0, I DAT A F, 5,0, 0) 

CALL CODE 

WRITE <IDATAF,206) CQNC<3) 

CALL CHAR<256. ,YP0S+32.,0, IDATAF,5,0, 0) 

CALL DREAD( NAHEF, 4, ILIHE> 

CALL LERS(YPOS) 

CALL CHARC0.,YP0S,0,ILIHE,46,3,0) 

CALL CHAR<384. ,YP0S,0, ILINE<25),8,3,0) 

CALL CHAR(464.,YPOS,0,ILINE<30),6,0,0) 

CALL IH<1,JTYPE,0.,0.,0,0,0,0,31,0,31,IX,IY) 

CALL CHAR<0.,YP0S,0,ILIHE,64,0,0) 

IF<IX .LE. 25)CALL CH AR( 46 4 . , YP 0 S , 0 , I ER S , 6 , 0 , 0 ) 

IF<IX .GT. 25)CALL CH A R( 38 4 . , YP 0 S , 0 , I ERS , 8 , 0 , 0 ) 

YPOS = YPOS - 32. 

IFtYPOS .LT. 64.0>YP0S = 45S.0 
DFALTC = .FALSE. 

IF<IX .LT. 28)DFALTC = .TRUE. 

C 

C DO LOOP OVER THE 10 POSSIBLE CONCENTRATION VALUES FOR THE PLOTS 

C 

IFCDFALTOGO TO 35 

CALL DREAD<HAHEF,5, ILINE) 

CALL LERS(YPOS) 

CALL CHARIO. , YPOS, 0,1 LINE, 6 4,0, 0> 

YPOS = YPOS - 32. 

IF<YP0S.LE.64) YP0S=458. 

35 DO 59 1=1,10 
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IF DEFAULT CONCENTRATION VALUES ARE NOT BEING USED. 

READ IN THE VALUE FOR THIS PLOT 

IFCDFALTOGO TO 37 

CALL DREAD( NAHEF. 6. ILINE > 

CALL LERS<YPOS) 

CALL CHAR<0.,YP0S,0,ILINE,17i3,0) 

CALL CODE 
WRITE ( IDX, 207 > I 

CALL CHAR< 11 1 . , YP0S,0, IDX, 1 .3,0 ) 

NIN = 9 

CALL BLANK< IDATAF.IO) 

"CALL IN<0,JTYPE. 1 44 . . YPOS. 0 , 1 DATAF . N I N. 0. 31 . 0. 3 1 . IX. lY) 

CALL CODE 

READ < IDATAF.* ) CONC< I ) 

CALL CHAR<0. .YPOS.O.ILINE. 17. 0, 0 ) 

CALL CHAR<111. .YPOS. 0. IDX. 1.0.0 ) 

YPOS = YPOS - 16. 

IFtYPOS -LT. 48.0)YP0S = 458.0 
37 IF<CONC<I> .LT. 0.0)G0 TO 61 

ITERATE TO FIND THE LOCATION OF THIS CONCENTRATION 
ON THE PLOT 

DIST = 0.0 
DINC = 1000.0 

41 CALL DFEXP( JTOP. CONC< I >) 

IF<Y1 .GT,. 0.0)GO TO 42 
DIST = DIST + DINC 

GO TO 41 

42 IF<DINC .LE. 100.0)G0 TO 43 
DIST = DIST - 900.0 

DINC = 100.0 
GO TO 41 

43 IF<DINC .LE. 10.0>G0 TO 44 
DIST = DIST - 90.0 

DINC = 10.0 
GO TO 41 

PLOT OUT THE CONCENTRATION LINE ON BOTH SIDES 

44 DIST = DIST -10.0 

IX = INTC0.2631** DIST * CDIR) + IXX 
lY = INT(0.3545 * DIST * SDIR) + lYY 

IFdX.LT.O .OR. IX. GT. 9999 .OR. lY.LT.O .OR. I Y . G T . 9 999 ) G 0 TO 59 
HUHA = 1 
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c 


c 


c 


c 


c 


IXft(NUMA) = IX 

IVft(NUMA) = lY • ; , 

NUMB = 1 
IXB(NUMB) = IX 
IYB<NUMB) = lY 

OIST = DIST + 10.0 

IX = IHT(0.2631 * (DIST * CDIR - Y1 * SDIR)) + IXX 

lY = INT(0.3545 * (DIST * SDIR + Y1 * CDIR)) + lYY 

IFdX.LT.O .OR. IX. GT. 9999 .OR. lY.LT.O .OR. I Y . GT . 9999 )G0 TO 59 

NUHA = 2 

IXA(NUMft) = IX 

lYA(NUMA) = lY 

IX = INT(0.2631 * (DIST * CDIR + Y 1 * SDIR)) + IXX 

lY = IHT(0.3545 * (DIST ♦ SDIR - Y 1 * CDIR)) + lYY 

IFdX.LT.O .OR. IX. GT. 9999 .OR. lY.LT.O .OR. I Y . GT . 9999 )G0 TO 54 

NUMB = 2 

IXB(NUMB) ,= IX 

IVB(NUMB) = lY 

46 DIST = DIST + 500.0 

CALL OFEXP( JT0P,C0HC( I )) 

IX = IHT(0.2631 * (DIST ♦ CDIR - Yi * SDIR)) + IXX 

lY = INT(0.3545 * (DIST * SDIR + Y1 * CDIR)) + lYY 

IFd'X.LT.O .OR. IX. GT. 9999 .OR. lY.LT.O .OR. I Y . GT . 9999 )G0 TO 54 

NUMA = NUMA + 1 

IXA(NUMA) = IX 

lYA(NUMA) = lY 

IF(Y1 ■ .GT'7 0.0)G'o to 52 
NUMB = NUMB * 1 
IXB(NUMB) = IX 
lYB(NUMB) = lY 
GO TO 54, 

52 IX = IHT(0.2631 * (DIST ♦ CDIR + Y1 * SDIR)) + IXX 
lY = INT( 0.3545 * (DIST * SDIR Y1 * CDIR)) + lYY 
IFdX.LT.O .OR. IX. GT. 9999 .OR. lY.LT.O .OR. I Y . GT . 9999 )G0 TO 54 
NUMB = NUMB + 1 
IXB(HUMB) = IX 
lYB(NUMB) = lY 
GO TO 46 

54 WRITE (12) -1, 1/ IXAd )dYA( 1 ) 

DO 56 J=2iNUMA 

56 WRITE (12) l.i.IXA( J). IYA( J ) 

IF(HU«B . EQ . 1 )G0 TO 59 
WRITE (12) -IddXBd ),IYB( 1) 

DO 57 J=2,HUHB 
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57 WRITE (12) 1,1>1XB( J). IYB(J ) 

C 

59 CONTIHUE 

ON THE PLOT. CROSS OUT EITHER THE WORD FORECAST OR SOUNDING 

61 IFdOPTd) .NE. 0)G0 TO 62 
WRITE < 12) -1. 1,707.604 
WRITE ( 12 ) 1,1 . 1 174.604 
GO TO 64 

62 WRITE (12) -1.1.1269.604 
WRITE (12) 1.1.1760.604 

PRINT OUT THE PREDICTION TIME ON THE PLOT 

64 WRITE (12) -1.1.1869.319 

WRITE ( 12.202) 1 00. 0 . 0 . 1 50 . I T IM E . L AU N TD( 4 ) , I DA Y , M ON T H . I Y E AR 

IF THE LAUNCH TIME WAS ENTERED. PRINT IT OUT ON THE PLOT 

IF( .NOT. LTI11E)G0 TO 67 
WRITE ( 12) -1. 1. 1869. 112 

WRITE ( 12.208) 1 00. 0. 0 . 1 50 . LT IM . LAUHTD( 3 ) . LAUNTD( 4 ) . LD AY . 
LMON.LYEAR 

OH THE PLOT. PRINT OUT THE CHARACTERS + AND 0 FOR THE LEGEND 

67 WRITE (12) -1.1.1041,1342 

WRITE (12.203) 1 50. 0. 0 . 1 50. 1H+ 

WRITE (12) -1.1.1041.1104 
WRITE (12.203) 1 50 . 0 . 0 , 1 50 . IH0 

FOR THE LEGEND ON THE PLOT. PRINT OUT THE CONCENTRATION VALUES 
FOR WHICH CONTOURS WERE DRAWN 

WRITE (12) -1.1,1066.9587 
DO 75 1=1.10 

IF(CONCd) .LT. 0.0)G0 TO 77 
IF( I .HE. 1 )G0 TO 72 
WRITE ( 12.204) 1 2 5. 0 . 0 . 1 50 . CONC ( I ) 

GO TO 75 

72 WRITE ( 12.205) 1 25. 0. 0 . 1 50 , COHC( I ) 

75 CONTINUE 

WRITE OUT COMMON DISK FILE 

<^7 CALL RWDIS( NAME. 1 ) 

C 

C CALL NGRAF TO RETURN SCOPE TO NORMAL MODE OF OPERATION 
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(APPROPRIATE ONLY WHEN USING PL AS N AS CO P E ) 

CALL HGRAF 

RETURN TO THE MAIN PROGRAM REED 
STOP 

END OF R I SOP 

END 

SUBROUTINE R UD I S < HA HE , J J ) 

COMMON ALT<31).AL1.C0NMAX. CON CPK, DEGRAD, ADIR.DOSPK. El. CLDHT, 

IDIR(31 I0PT(3), ITIME, IDAY,M0NTH(2), lYEAR.ISTIM, ISDAY, 
ISMON<2), ISYEAR,IV2'JT0P,JB0T,LAUHTD< lO.LTIHE.LTIM.LDAY, 
LH0H<2),LYEAR,LU,NUM,PI,PI0VR2,PI43,PRESS(31 ),PTEMP(31 ), 
SIGHCL,RADDEG,RAT0MC,CLDRAD,R2.R3,SAVEA<30),SAVER(30),SIGA/ 
SIGX0,SIGX,SPEED(31 ),SQR2PI,SURDEN,SIG20,SIGAP,S8,TEMP(31 
T0PSUR,TU0PI,ASPD,VPAR<18),CRTIME<31),DIST,YES,Y1,NUMRUN, 
YPOS , IFLAG< 5 ), ZB, ZZ , REFLEC, IRETRN 
LOGICAL LTIME 
INTEGER YES 

EQUIVALENCE ( QCl , VP AR< 1) ), < QC2, VPARC 2 > ) , ( Q C3 , V P AR ( 3 ) 

<QT1,VPAR<4)),<QT2,VPAR<5)),(QT3,VPAR<6)>, 

( AA, VPARC 7 ) ), ( BB, VPAR< 8 ) ),< CC, VPAR< 9) ), 

(HEATH, VPAR(10)>,(HEATM,VPAR(11)),(HEATA,VPAR(1.2)), 
(PHCL,VPAR(13)),(PC0,VPAR(14)),(PC02,VPAR(15)), 
(PAL203,VPAR(16)),(PN0iVPAR(17>),(GAMMAX,VPAR(18)) 
INTEGER ODCB( 1 44 ) , 0BUF( 669 ) 

DIMENSION HAME(3> 

EQUIVALENCE ( 0BUF( 1 ) , ALT( 1 ) > 

CALL 0PEN( ODCB , I ERR , N AME , 0 ) 

IF(JJ.EQ. IICALL URITF(ODCB, IERR,0BUF,669) 

IF( JJ . EQ. 0)CALL R E A DF ( OD CB , I E RR , OB UF , 66 9 ) 

CALL CLOSE( ODCB, lERR ) 

RETURN 

END 

SUBROUTINE DFEXP( J , CONC ) 


THIS SUBROUTINE CALCULATES DIFFUSION EXPONENTIALS 

J - INDEX IN THE ALT ARRAY OF THE TOP OF THE LAYER 
CONC - CONCENTRATION TO BE TESTED 


COMMON BLOCK 
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CONHOH ALTC31 COHHAX/ COHCPK. DEGRAD < AD IR.DOSPK/ El/ CLDHT< 

iDlROi )/ 10PTC3)/ 1TIHE/1DAY/H0HTH<2 >/ lYEAR/ ISTIH/ ISDAY/ 
ISH0H(2>/ ISYEAR/1V2/ JTOP/ JBOT/LAUHTD< 10 >/LTIME/ LTIH/ LDAY/ 
Ln0H(2>/LYEAR/LU/NUM/PI;PI0VR2/PI43/PRESS(31 )/PTEHP(31 >/ 
SICHCL/RADDEG/RATONC/CLDRAD/R2/R3/SAVEA(30>/SAVER<30>/ SIGA/ 
SIGXO/SIGX/SPEED( 31 > . S6R2PI / SURDEN / SI GZ.O / S IG AP/ S8/ TEHP< 31 >/ 
T0PSUR/Ty0PI/ASP0/VPAR<l8>/CRTIHE(31>/DIST/YES/ Yl/NUHRUN/. 
YPOS. IFLAG<5)/ZB/Z2/REFLEC/ IRETRN 
LOGICAL LTI«E 
INTEGER YES 

EQUIVALENCE < QCi / VP ARCl ) >/ ( QC2/ VPAR( 2 > > / ( QC3 / VP AR< 3 > >/ 

<QT1 / VPARC 4) )/ ( QT2/ VPAR( S)>,< QT3/ VPAR(£ > >. 

< AA/ VPAR<7 >)/( BB, VPAR< 8> ).( CC/ VPAR<9) )/ 

<HEATH/ VPAR< 10 ))/ (HEATH/ VPAR< 1 1 ) ) / ( HE AT A , V P ARC 1 2 ) ) , 
(PHCL. VPARC 13) ) /( PCO . VPAR< 14) ) , ( PC02/ VPAR( 15 ) )/ 
(PAL203/ VPAR< 16 ))/( PNO/ VPAR< 17 )) /< GAHHAX, VPAR< 18) ) 


CALCULATE SIGHA Z 

SIGZ = DIST * SIGAP + SIGZO/1.28 
R3 * 2 .0 » SIGZ * SIGZ 

CALCULATE THE EXPONENTIAL SUN IN THE DIFFUSION EQUATION 

TUOI » 2.0 
ZT = ALTC J ) 

TEHP2 = CLDHT - ZZ 

TEHP3 = CLDHT - 2.0 • ZB + ZZ 

El = EXP< - TEMP2 ♦ TEHP2/R3) + 

EXP< - TEHP3 * TEHP3/R3) 

4 TEMPI = TUOI * (ZT - ZB) 

TEXPSH = El 

TEXP = (TEMPI - TEHP2 )**2/'R3 

IF(TEXP .LE. 120.0)E1 = El + EXP( - TEXP) 

TEXP = (TEMPI + TEMP2)**2/R3 

IFCTEXP .LE. 120.0)E1 = El + EXP( - TEXP) 

TEXP = (TEMPI - TEMP3)*»2/R3 

IFCTEXP .LE. 120.0)E1 = El + EXPC - TEXP) 

TEXP = (TEMPI + TEMP3 )**2/R3 

IFCTEXP .LE. 120.0)E1 = El + EXPC - TEXP) 

IFCEl .EQ. TEXPSM)GO TO 7 
TWOI = TWOI + 2.0 
GO TO 4 

7 El = REFLEC ♦ El 

CALCULATE SIGHA Y 
S8 = DIST * SIGAP + SIGXO 
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R2 - SQRT<S8 * S8 + <0.0040389 * FLORTC ID I R( J > - IDIR(1>) • 

DIST)**2) 

C 

C CALCULATE CLOUD LENGTH 

C 

TEHPl » SPEEDCJ) - 8PEED<1> 

ALl = 0,28 * TEMPI * D1ST/A6PD 
1F<TENP1 .GE. 0.0)G0 TO 11 
IF<PTEMP< J>-PTEMP<1) . CT . 0.0)AL1 » 0.0 
ALl > ABSCALO 

CALCULATE SIGMA X 

11 SIGN > SQRT<<ALl/4. 3)*«2 * SICXO * SIGXO) 

IF C0NC>=1000. 0. DO NOT CALCULATE CROSS WIND DISTANCE BUT RETURN 
TO THE CALLING PROGRAM 

IF<CONC .EQ. 1000 .0 )RETURN 

CALCULATE CROSS UIND DISTANCE 


VI » - 2.0 * R2 « R2 « AL0G(15.749S * COHC * SIGX * R2 * 

SIGZ/(SIGHCL * El >> 

VI = SQRT<AMAX1< Vli 0. 0 )) 

RETURN TO THE CALLING PROGRAM 
RETURN 

END OF DFEXP 


END 

SUBROUTINE 0 RG I N ( I X 0 . I VO > 


THIS SUBROUTINE GIVES THE APPROPRIATE COORDINATES FOR PLOTTING 
FOR THE COMPLEX AND HAP SELECTED 


COMMON BLOCK 

COMMON ALT(31).ALl.C0NMAX/C0NCPK.DEGRAD<ADIRiD0SPKiEl.CLDHT. 

ID1R< 31 IOPT< 3 >, ITIME, IDAV ,MOHTH< 2 lYEAR. ISTIM, ISDAV , 
ISM0H<2>/ISVEAR>IV2<JT0P#JB0T<LAUNTD(10>>LTIHE^LTINiLDAV> 
LM0N< 2>.LVEARi LU/NUN,P1/ PI0VR2.PI43<PRESS< 31 >>PTEHP< 31 >> 
SIGHCL. RADDEG/ RAT0HC.CLDRAD,R2<R3/ SAVEA< 30 >, S AVER< 30 S IG A. 


A-151 



oooo ooooo. ooo o o o o o n ooo 


SIGX0<S1GX.SPEED( 31 >.SQR2PI >SURDEH, SIG.Z0iSIGAP.S8, TEHP( 31 
TOPSUR. TUOPI iftSPD,VPAR(18 >. CRTIHE< 31 ).D1ST. YES. Y1 , HUHRUH. 
YPOS. IFLAG<5).ZB.ZZ.REFLEC. IRETRH 
LOGICAL LTIME 
INTEGER YES 

EQUIVALENCE < QC 1 . VP AR< 1 ) ), < QC2. VPAR< 2 ) ) . < QC3 . VP AR< 3 ) ). 

<QT1 . VPARC 4 ) ), < QT2. VPAR< 5 ) ) ,< QT3. VPAR<6 ) ). 
<AA.VPAR<7)).(8B,VPAR<8>).(CC.VPAR(9)>. 
<HEATN.VPAR(10)).<HEATH.VPAR<in>.(HEATA.VPAR(12>). 
<PHCL.VPAR<13)),(PC0.VPAR(i4)).(PC02.VPAR(15)). 
<PAL203 . VPAR( 16 >).< PNO, VPARC 1 7 >>, ( GAMHAX , VPAR< 18) > 
DIMENSION IL IHE( 32 ) . lOATAFt 10 >. IERS< 32) . IHAPL( 48 ) . HAHEF( 3 > 

INPUT FORMAT STATEMENT 

100 FORMAT < 12. IXAl ) 

OUTPUT FORMAT STATEMENT 


TYPE AND DIMENSION STATEMENTS 

LOGICAL NOTIST 
DIMENSION IX<8 ). IY< 8) 

DATA STATEMENTS 

DATA IERS/32*2H / 

DATA HAMEF/2H7R. 2HIS. 2H0P/ 

DATA IMAPL/2H40. 2H, S. 2HEA. 2H M.2HAP.2H . 

1 2H40. 2H, L. 2HAN. 2ND .2HMA.2HP . 

1 2H4 1 / 2H. S. 2HEA. 2H M.2HAP.2H . 

1 2H41.2H.L.2HAN.2HD .2HHA.2HP . 

1 2H1 7. 2H. S. 2HEA. 2H M.2NAP.2H . 

1 2H17. 2H. L. 2HAN. 2ND .2HMA.2HP . 

I 2H39. 2H. S. 2HEA. 2H M.2HAP.2H . 

1 2H39. 2H. L. 2HAN. 2ND .2HMA.2HP / 

DATA NOTIST/ .FALSE. /. LCHAR/IHL/ 

DATA IX/5 45 0,541 1.4 83 0.4 82 5. 8 75 0.8730, 4100. 4100/ 

DATA IY/2630. 8 24 3. 2465. 8 05 0.2990, 8600. 1700. 7300/ 

IS THIS THE FIRST TIME THROUGH THIS SUBROUTINE? -- 
IF NOT. IT IS NOT NECESSARY TO CALCULATE THE INDEX OF THE 
COORDINATES. I, AGAIN 

IF(H0T1ST)G0 TO 7 

THIS IS THE FIRST TIME THROUGH -- READ IN THE COMPLEX NUMBER 
AND THE DESIRED MAP, i.e. SEA OR LAND 
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HOTIST = .TRUE. 

CALL DREAD< NAHEF. 7. ILIHE > 

CALL LERS<YP0S> 

CALL CHAR(O.^YPOSiOiILIHE,64iO.O> 

YPOS = YPOS - 16. 

IF<YP0S .LT. 48. ) YPOS = 458. 

IF<I0PT<3r.EQ. 1> CALL DR EA D < N AH E F , 8 , I L I NE ) 

IF< lOPTO ). EQ. 2 ) CALL DR E A D « N AH E F . 9 , I L I NE ) 

IF< I0PT(3 ). EQ.O) CALL DR E A D < N AH E F , 1 0 , I L I N E ) 

CALL LERS(YPOS) 

CALL CHAR<24.,YP0S.0,ILINE(2),8.3.0) 

CALL CHAR<95 . , YPOS, 0. ILINE< 7) , 50 , 0 i 0 ) 

CALL 1N(1,JTYPE,0.,0.,0,0,0,0,31.0,31,IXC,IYC) 
CALL CHAR< 0 . , YPOS , 0 , lERS , 64 , 0 , 0 ) 

CALL CHAR<200.,YP0S+16i0,IERS,25,0,0) 

IF( IXC . LT .6 . AND. lOPTC 3 ) . EQ . 1 ) 1 = 1 
IFUXC.GT. 5. AHD.IXC.lt. 12. AND. I0PT(3).EQ.1> 1 = 2 
IF< IXC . GT . 1 1 . AND . IXC . LT . 18 . AND . I0PT< 3 ) . EQ . 1 ) 1 = 3 
IF<IXC.GT.17.AND.I0PT(3).EQ.l) 1=4 
IF<:iXC.LT.6.AND. I0PT(3).Ee.2) 1=5 
IF<IXC.GE.6.AND.I0PTC3>.EQ.2) 1=6 
IF<IXC.LT.6.AND.IOPT<3).EQ.O) 1=7 
IF<IXC.GE.6.AND.IOPT(3).EQ.O) 1=8 
I HP = < I - 1 )>t^6 + 1 

CALL CHAR(208.,YP0S + 16.,0,IHAPL<:iMP),12,0,0) 

YPOS = YPOS - 16. 

IFCYPOS . LT . 48 . ) YPOS = 458. 

SET THE COORDINATES BASED ON THE INDEX I 

7 IXO = IXC I) 

I VO = I Y< I ) 

RETURN TO THE CALLING PROGRAM 
RETURN 

END OF ORGIH 


END 

SUBROUTINE SYMBL<IUIDE,IHI,ISYMB) 

IX=- IWIDE/2 

IY=-IHI/2 

WRITEC 12) -1 ,-l, IX, lY 
WRITE<12,100) IUIDE,0,0,IHI,ISYMB 
100 FORHATC 415, Al, 1H_ ) 

I Y=- lY 

MR ITEC 12 )-l , -1 , IX , I Y 

RETURN 

END 
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SUBROUTINE DREAD( NANEF . LNUN < I LI NE > 

DIMENSION NAHEF<3>/ I0C6(276>i IBUF< 40 > . I LI NE( 32 > < 1 PAR( 5 > 
CALL RHPARC IPAR ) 

LU = IPARCl > 

CALL OPEN( IDCB. lERRiNANEF. 0 > 

LOOP = LHUH - I 
DO 10 I^l.LOOP 
CALL BLANK( IBUF/ 40) 

CALL READFdDCBi IERR< IBUF) 

10 CONTINUE 

CALL BLANK< IBUF, 40) 

CALL READF( IDCB, lERR, IBUF) 

CALL CODE 

READC IBUF, 100) ( I LI HE< I ) , I > 1 , 32 ) 

100 F0RHAT<32A2) 

CALL CLOSEC IDCB, lERR) 

RETURN 

END 

SUBROUTINE BLANK( IBUF , 1 1 ) 

DIMENSION IBUF(40) 

DATA IBLK/2H / 

DO 10 1=1,11 
10 IBUFC I > = IBLK 
RETURN 
END 

SUBROUTINE LERSCYPOS) 

DIMENSION IERS(32) 

DATA IERS/32*2H / 

IF( YPOS .LE. 48) YPOS = 458.0 
CALL CHAR(0. ,YP0S,0,IERS,64,0,0) 

CALL CHAR(0.,YPOS-16.,0,IERS,64,0,0) 

RETURN 

END 

END$ 



Program MIXH 
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PROGRAM MIXH 

DIMENSION IPARC5)/2<20),TV<20),IDCB(2 56 ),IBUF<40).FD<20),P(20) 
DIMENSION NAME<3 OUM( 20 ), I TESTC 40 T< 20 ) , VP< 20 ) 

DIMENSION I T IME< 3 I0ATE<6 ) 

DATA C 1 , C2, C3/- . OOOSi - . 005, 100 . / 

DATA HAME/2HiH,2HIX,2HDl/ 

OTV< I ) = TV< 1+ 1 ) - TV< I ) 

DZ< I ) = Z( I + l ) - 2( 1 ) 

GTV< I ) = DTV( I ) / D2( I ) 

DS(I ) = Z< I + 1 ) - Z< 1 ) 

CALL RMPAR< I PAR ) 

C ** OPEN &MIXD1 DATA FILE 

CALL OPEN< IDCB , I ERR , NAME, 0 ) 

LU = IPAR< 1 ) 

C ** INITIALIZE FLAGS TO ZERO 
IFLGI = 0 
IFLBS = 0 
IFLTS = 0 

C *■* THIS IS TO INPUT THE TIME AND DATE 
CALL READF< IDCB, lERR, IBUF> 

CALL CODE 

REAO< I BUF , 20 1 ) IDATE,ITIME 
201 FORMAK 6A2, 2X, 3A2 ) 

DO 444 1=1,20 

CALL READF< IDCB, lERR, IBUF) 

CALL CODE 

READ<IBUF,*> Z<I ),T<I ),P<I >,FD< I > 

C ** CONVERT Z<I) TO METERS 
Z( I > = Z( D* . 3048 
C ** CONVERT FD<I) TO DECIMAL 
FD< I ) = FD< I )/ 100 . 

VP<I) = 6 , 1 1 *FD< I )* 10 . *♦( 7 . 5*T( I )/( T( I ) + 237 . 3 ) > 

TV<I) = ( T( I )+273 . 1 6)*<: 1 .+ . 376932*VP< I )/P( I ) ) -273.1 6 
444 CONTINUE 

C ** Z( I ) IS ALTITUDE IN METERS 
C ** TV(I) IS VIRTUAL TEMPERATURE IN DEG C 
C *** P<I) IS PRESSURE IN MILLIBARS 
C ** FD< I) IS RELATIVE HUMIDITY 
C ** WRITE INPUT VARIABLES 
WRITE<6,6999) 

6999 F0RMAT<1H1,“ ALTITUDE " 5X , “ TE M P E R A T UR E " 3 X " PRESSURE “5X 
IRRELATIVE HUMIDITY" ) 

yRITE(6,7000) <Z(I),TV(I),P<I),FD(I),I = 1,20) 

7000 FORMATCIH , 4 < F 1 0 . 3 , 5X ) ) 

C ** SPECIFICATION OF HEIGHT OF GROUND BASED INVERSION 
I = 1 

IFCGTVC I ) .LT .Cl) GO TO 2 

DO 11 I = 2,19 

IF<GTV< I ) .LT .Cl ) GO TO 12 
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11 CONTIMUE 

UR ITE< 6,6000 ) 

6000 F0RMATC//,1H0, “INVALID DATA") 

GO TO 4 

12 IF<OS< I ) . GE . C3 ) GO TO 100 
GO TO 2 

2 URITE< 6, 1000 > 

1000 FORMATC // , 1 HO, “NO SURFACE BASED INVERSION") 

IFLGI = 1 
GO TO 4 

100 WRITE< 6,2000 ) Z( I > 

GI = Z< I ) 

GO TO 4 

2000 F0RNAT(//,1H ,"TOP OF SURFACE BASED INVERSION = “,F7.2> 

C ** SPECIFICATION OF THE BASE OF THE FIRST STABLE LAYER 
4 D010I=2,19 

I F<: GTV< I ) . GE . C 1 ) GO TO 60 
10 CONTINUE 

6 UR ITE< 6 , 3000 > 

IFLBS = 1 

CALL CLOSE( I DCB, I ERR ) 

GO TO 9000 

3000 FORMAT< // , 1 HO, "NO STABLE LAYERS") 

200 URITE( 6,4000 ) Z< I ) 

BS = 2(1) 

GO TO 30 

4000 FORMATC /V , 1 HO, "BASE OF FIRST STABLE LAYER = ",F7.2) 

60 J = I + 1 

DO 61 I = J , 19 

I F< GTV<- i > . GE , C 1 . AND . DSC I ) . GE , C3 ) GO TO 200 

61 CONTINUE 
GO TO 6 

C ** SPECIFICATION OF THE TOP OF THE FIRST STABLE LAYER 
30 J = I + 1 

DO 210 I = J , 19 
IF(GTV(I).LE.C2) GO TO 300 
210 CONTINUE 

GO TO 400 

300 WRITEC 6,5000 > Z( I ) 

TS = Z< I ) 

5000 FOR«AT< // , IHO, "TOP OF FIRST STABLE LAYER = ",F7.2) 

CALL CLOSE< IDCB, lERR) 

GO TO 9000 
400 HR ITE< 6 , 600 1 ) 

600 1 FORKATt , 1 HO, “TOP OF STABLE LAYER AT ALTITUDE EXCEEDING THE" 
11X"MAXIMUN ALTITUDE OF AVAILABLE DATA") 

CALL CLOSEC IDCB, lERR) 

IFLTS = 1 

C *** WRITE OUT DATE-TIHE FOR GI,BS,TS . 

9000 CONTINUE 
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«RITE<6,9001 ) 

9001 F0R«AT<1H1," DATE AHO TIME "6X“GRHD INV"6X"BASE LAYER"6X 
1 "TOP LAYER" ) 

l}RITE< 6 /9002 ) IDATE>ITIME 

9002 FOR«AT< IX. 6A2, 2X, 3A2) 

IF< IFLGI . EQ . 1 ) WRITE< 6. 9003 > 

9003 FORMATC 1H*.22X."N0HE" > 

IFUFLGI . EQ . 0) U R I T E< 6 , 9 00 4 > GI 

9004 FORMAT< IH*. 22X .F5 . 1 ) 

IF< IFLBS . EQ . n WRITE< 6,9005> 

9005 FORHATC IH*. 36X. "KOHE" ) 

IFC IFLBS. EQ . 0) M R 1 T E( 6 , 900 6 > BS 
900B FORMATt IH*. 36X .F5 . 1 ) 

IF< IFLTS. EQ . 1 ) MRITE< 6.9007 > 

9007 FOR«AT< IH*. 53X . "NOHE" ) 

IF< IFLTS. EQ . 0) UR I T E< 6 . 900 8 > TS 

9008 FOR«AT< IH*. 53X. F7 .2 ) 

EHD 

EHD« 
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PROGRAM JWSPL 

CO MM OK IDATE<8).ITIHE<3)>IDCB(i44)iIBUF(40>/LU/IDSAV(8)/ISAVF 
1/ NEUD 

DIMENSIOH lAXIClI). Xyi<3), X Y2 ( 3 ) , I V T I T( 2 1 ) , I S DA T< 8 ) 

DIMENSION US 1< 800 yS2< 800 ) , 

DIMENSION I YLAB< 8 IXLAB( 12 IXLAB3< 2 ), NT I ME( 4 ) 

DIMENSION IXLAB2(3).0KPLT(3)4lXDATE(9>.IXTIT(21> 

DIMENSION H.EG 1< 7 ILEC2( 1 4 ), ILEG3( 1 4 ) 

DIMENSION HUMF8< 2 IPAR( 5). NAME! 3 NAMEl ( 3 ) . NAME2C3), HAME3(3) 
DATA ILEG1712i 2HHA,2HSA,2H -,2H M,2HSFi2HC / 

DATA XYl /O . , - . 3 . - . 6/ 

DATA XY2/0 . , . 3/ . 6/ 

DATA ILEG2/2S. 2HSP> 2HAC. 2HE . 2H S C . 2H I E . 2H N C . 2H E S . 

12H L . 2HAB , 2H0R , 2HAT , 2H0R , 2HY / 

DATA IAX172,2H 2,2H 4.2H 6,2H 8 . 2H 1 0 . 2H 1 2 . 2H 1 4 , 2H 1 6 . 2H 1 8 , 2H 20 / 
DATA ILEG3/26. 2HAE. 2HR0, 2HSPi 2HAC, 2HE , 2H E H , 2H V 1 , 2H R 0 . 

12HNM.. 2HEN,. 2HT ,2HDI>2HV./ 

DATA I YLAB,-' 1 4, 2HAL/ 2HT I, 2HTU, 2HDE, 2H (,2HKM;2H) / 

DATA NTIME75/ 

DATA I XLAB/2 1 . 2HSC, 2HAL. 2HAR^ 2H U.2HIN,2HD , 2HSP. 2HEE, 2ND . 

1 2H<M.2HS / ■ 

DATA IXLAB2/2. 2H-1/ 

DATA IXLAB3/1. 2H ) 7 

DATA IXTIT740,2H . 2H P 0 , 2H I N , 2H T , 2H M U . 2H G U . 2H J.2HIM.2HSP, 

1 2HHE,2HRE/2H H . 2 H I N ; 2 H 0 , , 2 H PR , 2 H OF . 2 H I L i 2 H E ,2HDA,2HTA7 

DATA I YTIT740, 2HCA. 2HPE. 2H K, 2H E N . 2H.N E . 2H D Y , 2H J/2HIM.2HSP/ 

I 2HHE,2NRE;2H «.2HIN,2HD; . 2 H PR - 2 H OF . 2 H I L , 2 H E ,2HDA.2HTA7 
DATA IXDATE/167 

DATA HAME1/2H£,J. 2HKS. 2HC1/ . 

DATA NAME272HS...J.. 2HKS, 2HC2/ 

0ATAIfAME3/2He.J.2HPT,2HM/ 

C ** INITIALIZE LU DEVICE 
LU = 7 

*•+ OPEN DATE AND TIME FILE 

CALL OPEN< I DCB , I ERR , NAME , 0 ) 

INITIALIZE PLOTTER 
CALL PLTLU(.12) 

NEUD = 0 
I F 1 = 0 
I NAME = 0 
I 3 A V F = 0 
I ROY = 0 
CALL CLEER 
UR ITE(. LU, 40 5 > 

405 FORMATC // ”***+NAS A7MSFC JIMSPHERE UIND PROFILE PLOTTING" 

I I X "PROGRAfU*** “ ) 

WRITE! LU, 214 ) 

214 F 0 RM AT ( 7 " J i n sp he r e Wind Profile Data De s i r e d ? " 5 X “ U I N D SPEED" 

, 110X"WIND DIRECTION" ) 
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CALL TOUCHC 0, 31, 0 .31. IX. lY > 

IX = IX/2 
IV = IY/2 

IFdX.LT. 1<>) GO TO 215 
URITE< LU. 216 > 

216 FORM AT( /" Use Progran JUOPL For Wind Direction Plots") 
WRITE<LU,217) 

217 FORMATC/." *♦** JWSPL *** TERMIHATEO •**•“) 

STOP 

215 CONTINUE 

UR1TE<LU. 102) 

102 F0RMAT< /. “J i nsphere Wind Profile Data D es i re d? " 5X " C A PE KENNEDY* 
110X"P0INT MUGU") 

CALL T0UCH< 0,31. 0.31. IX. lY ) 

IX = 1X72 
lY = IY72 

IF< IX . GT . 10 ) GO TO 71 
ICK =» 1 
WR1TE< LU. 103 ) 

103 F0RMAT( /, 5X, "Cape Kennedy Data Desired?"10X“1964-1966" 

19X" 1967-1 970" ) 

104 F0RMAT< 7, lOX'Poi nt Mugu Data Fori 1 965-1 970 ") 

CALL T0UCH< 0,31, 0,31. IX. lY ) 

IX = 1X72 
lY = I Y72 

IF< IX . LE . 9) URITE<LU. 105 ) 

IF<IX.LE,9) INAME =1 
IF< IX. GT. 9) WRITE<LU. 106 ) 

IF< IX. GT. 9) INAME = 2 
IF< INAME.EQ . 2) GO TO 172 
DO 141 K^l,3 
HAMECK) = HAMEKK) 

141 CONTINUE 
GO to 173 

172 CONTINUE 

DO 142 K = 1 ,3 
NAME<K ) = NAHE2< K ) 

142 CONTINUE 

173 CONTINUE 

105 F0RMAT( 7. lOX "Cape Kennedy Data Fori 1964-1966") 

106 F0RMAT<7, lOX'Cape Kennedy Data Fori 1967-1970") 

GO TO 72 

71 CONTINUE 

DO 171 J»1.3 
NAMEC J ) = HANE3( J > 

171 CONTINUE 

WRITE! LU, 104 ) 

72 CONTINUE 

C WRITE! LU, 108 ) 

C108 FORMAT! 77 ," J i nsphere Wind Speed Data Being Processed") 
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WRITE< LU. 400 > 

400 FORMAU /"/ , ■ TURN ON PLOTTER .... POSI TI ON PAPER TOUCH PANEL UHEH* 

IIX'READY" ) 

234 CONTINUE 
XXI = 56. 

XXI = 34. 

XXI = 30. 

CALL TOUCH< 0,31i 0.31, IX, IV ) 

IX = IX/2 
lY = IY/2 

IF< IX . GT . 15 ) GO TO 234 
C THIS IS WHERE THE DISC FILE IS OPENED 
CALL OPENC IDCB, lERR ,HAME,0 ) 

CALL CLEER 
«R ITE( LU, 907 ) 

907 F0Rt1AT< 7“ ♦***PLOTTI HG HAS BEEN I NI TI ALI ZED»* + * ” ) 

941 CONTINUE 
69 IFLAG = 0 
CALL LLEFT 
CALL SFACT( 15. , 10 . ) 

CALL PLOT< 1 . . 1 . 5 , -3 ) 

C ■+* WRITE NASA LEGEND 

CALL PLOT< 0 . ,0 . , 3 ) 

CALL PLOT<- . 5, - . 95, 3) 

CALL SYnB<-.5,-.95. .1,ILEG1,0.,1) 

CALL PLOT<- . 5, -1 . I, 3) 

CALL SYM8<-.5.-l.l, .08,ILEG2,0.,1) 

CALL PLOT< - . 5, -1 . 25 , 3 ) 

CALL SYMB(-.5.-l.25,.08,ILEG3,0.,l) 

C ** THIS PORT•^ON DRAWS Y-AXIS 
CALL PL0T<0 . .0 . , 3 ) 

CALL PLOTCO . ,0 . , 2 ) 

CALL PLOTCO . .5 . . 2 ) 

DO 30 1=1,10 
A = 1/2 . 

CALL PLOTCO . , A,3 ) 

CALL PLOTC . 05, A, 2 ) 

B = 1*2 

CALL HUHBC - . 3, A, . 1, B, 0 . , -1 ) 

30 CONTINUE 

CALL SYHBC- . 45, 1 . 9, . 1 0 , I YLAB, 90 . , 1 ) 

C ** THIS PORTION WRITES HEADERS AND LEGEND 
CALL SYHBC3.5, - 1 . 1 , . 1 0, IXLAB , 0 . , 1 ) 

CALL SYHBC5.6,-1.0, .1,IXLAB2,0.,1) 

CALL SYM8C 5 . 8, -1 . 1, . 1 0 , I XL AB3 . 0 . , I ) 

IFC INAME. EQ . 0) CALL S Y MBC 2 . 3 , 6 . 0 , . 1 2 , I X T I T ,.0 . , 1 ) 

IFC INANE . GT . 0 ) CALL S YHBC 2 . 3, 6 . 0 , . 12 , I YTI T , 0 . . I ) 

C *♦ THIS PORTION READS THE FIRST HSl DATA ARRAY 
IFCIFl.EQ.O) CALL RHS2C HSl , IFLAG > 

IFCNEWD .EQ. 1 > GO TO 941 
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IFl = 1 

IF( ISftVF . NE . 1 ) GO TO 129 
DO 128 J=1.8 
I DftTE( J ) = IDSAV< J ) 

128 CONTINUE 

IF< ISftVF. E8 . 1 ) ISftVF = 0 

129 CONTINUE 
IFLAG = 0 

DO 571 KL=1,8 
KP = KL + 1 

IJ<DftTE<KP) = IDftTE(KL) 

571 CONTINUE 

CALL SYMB<4.,5.70i.l2.IXDATE.0.,l) 

X = 0. 

XYll = XYK 1 ) 

XY22 = XY2< 1 > 

XYFLG = 1 

C this portion DRAWS THE X AXIS ♦♦*****♦* 
95 CALL PL0T< 0 . , 0 . . 3 ) 

CALL PLOT< X , XY 11 . -3 ) 

XX=0 . 

DO 456 1=1,799 

IF< WSl < I ) . GE . 1 00 . ) GO TO 456 
XX = AMAXK XX, WSK I )) 

456 CONTINUE 

IX = XX/10 + 2 
IF< IX. GT. 6) IX = 6 

XI s .5 + (IX - 2)* .5 
CALL PLOT(XI ,0 . , 2 ) 

DO 35 1=1 , IX 
A = ( I - I )/2 . 

D = < I - 1 )*1 0 . 

CALL PLOT( A ,0,3) 

CALL PLOT( A , . 05, 2 ) 

B = A - .05 

CALL NUMB(B, -. 15, . 1 ,D,0. ,-l ) 

35 CONTINUE 
B = 0 . 

JC = 0 

CALL PL0T(0 . ,XY22,-3) 

IFOJSK 1 ) .GE . 100 . ) GO TO 642 
A = «S1(1)720. 

B= B + .00625 

CALL PLOT< A, B, 3) 

642 CONTINUE 

DO 36 1=2,799 
B = B + .00625 

I F( MSK I) .GE . 100 . ) GO TO 643 
A = USK I >/20. 

JC = JC + 1 
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IFCJC.EQ.i) CALL PL0T(A/B/3) 

CALL PL0T<A,B/2) 

CCa B 

643 COHTIHUE 

36 COHTIRUE 

C * A -.25 
D * CC+ .05 
MTI«E<2) = ITIHEC 1) 

HTII1E<3) * 1TIME<2) 

MT1HE<4) = ITIHE<3) 

CALL SYHB(C,D/ .OB^NTIHE/O. / 1> 

CALL RUS2CUS2. IFLAG > 

IFtHEVD .EQ. 1 > GO TO 941 
IF< IFLAG. EQ .0) GO TO 70 
DO 96 1=1/799 
USK I > = US2< I ) 

96 COHTIHUE 

GO TO 69 

70 X = 0. 

DO 300 1=1,799 

IF<USI< I ) .GE . 100 , OR .US2< I ) . G£ . 100. ) DIFF = 0. 
IF(ySl< I ) .GE . 100 . OR .US2( I ) . GE . 100. ) GO TO 300 
DIFF = HSK I ) - WS2< I ) 

X = AHAXKX, DIFF ) 

300 COHTIHUE 

X = < X/20 . ) 

IFtX .LE . . 5) X = 0.5 
IF<X .GT . . 5 . AHD . X . LE . 1 . ) X = 1.0 
IF(X . GT . 1 . . AHD . X . LE . 1 . 5 ) X = 1.5 
IF<X GT . 1 . 5 . AHD. X . LE . 2 . ) X = 2.0 
IF(X.GT.2. .AHD.X.LE.2..5) X = 2.5 
X = X + 0 .5 

IF(XYFLG. EQ . 1) XYll = XYK2) 

IF< XYFLG. EQ . 1 ) XY22 = XY2<2) 

IFCXYFLG . EQ . 2 ) XY22 = XY2<3) 

IF<XYFLG. EQ . 2) XYll = XYK3) 

IF<XYFLG. EQ . 3) XYll = XYKl) 

IF<XYFLG. EQ . 3) XY22 = XY2< 1 ) 

IFtXYFLG. EQ . 3) XYFLG = 0 
IF<XYFLG. EQ . 3) CALL P L 0 T ( 0 . , . 6 , - 3 ) 

XYFLG = XYFLG + 1 
DO 80 1=1,799 
WSK I ) = WS2<I ) 

80 CONTINUE 
GO TO 95 

999 CALL URITE 

CALL CLOSE< IDCB, lERR) 

STOP 

END 
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SUBROUTINE CLEER 
INTEGER RSFF 
DATft RSFF/017014B/’ 

CALL EXEC( 2 . 1078. RSFF. -2 ) 

RETURN 

END 

SUBROUTINE RUS2( US2 . 1 FLAG > 

COHMOH IDATE<8).ITII1E<3).IDCB<144).IBUF<40>.LU.IDSAV(8).ISAVF 
1. NEUO 

DIMENSION US2<800> 

DATA IBLK/2H / 

ICF = 0 

I F< HEWD . EQ . 1 ) GO TO 942 
15 IK = 1 

D051K=1.100 
KK = Kt<8 

REA0<8.*) < US2< I J ). IJ = IK,KK > 

IK = IK + 8 
51 CONTINUE 

CALL RE ADF( I DCB. I ERR. I BUF ) 

CALL CODE 

READ<IBUF.300)<IDATE<NN).MN=1.8).<ITIME(NK>.NK=1.3) 

300 FORMAT< 8A2. 3X. 3A2 ) 

IF< IDATE< 1 ) . EQ . IBLK ) GO TO 20 
DO 89 J=1 .8 
I DSAV< J > = IDATE< J ) 

89 CONTINUE 

IFC ICF . EQ . 1 ) GO TO 953 
IF< IRDY .EQ. 0 ) GO TO 45 
CALL CLEER 
MRITE< LU. 580 ) 

580 FORMATC/.-DO YOU WISH TO TERMINATE P R OG R A II ? " 1 0 X " Y ES " 1 0 X " N 0 " ) 

CALL TOUCH( 0,31. 0 ,31. IX, lY ) 

IX = IX/2 
lY = IY/2 

IFdX.LT.lO) WRITE! LU. 349) 

IF< IX. LT. 10 ) STOP 

349 FORMAT! /'■>|.•**PROGRAM JIMPL HAS BEEN TERMINATED****") 

WRITE! LU. 101 ) 

101 FORMAT! // “CHANGE PLOT PAPER TOUCH PANEL TO CONTINUE") 

CALL TOUCH! 0 , 31 . 0 ,31 . IX. IV ) 

IX = IX/2 
lY = IY/2 

IF! IX. LT. 15 ) IFLAG = 1 
45 CONTINUE 

I RDY = 1 . 

WRITE! LU. 100 ) ! I D AT E! N K ) . N K = 1 . 8 ) 
k>0 FORMAT! // "New Date is! "8A2) 

C RETURN 

WRITE! LU. 940 ) 
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940 F0RMAT< *0 i ff erent Date Des i red?" lOX ■■ YES " 10X“ NO" ) 

CALL T0UCH<0,31. 0.31, IX, IV ) 

IX = IX/2 
lY = IY/2 

IFdX.GT.C) GO TO 942 
WRITE< LU. 951 > 

951 FORMAK /"ENTER NUMBER OF CURVES SKIPPED? _“) 

READ(LU.f) ICURS 
NFB = ICURS - 1 
IFB = NFB 
NFB = NFB*100 
CALL PTAPE( 8 , 0 . NFB ) 

CALL POSNT< IDCB. lERR. IFB.O ) 

ICF = 1 
GO TO 15 
953 CONTINUE 
942 CONTINUE 
NEUD s 0 
ISAVF = 1 
20 CONTINUE 

URITE<LU.301XITIME<NK).NK*1.3) 

301 FORMATC // "T i me of Curve is! "3A2.5X"Plot D es i r e d? " 1 0 X " YES " 1 OX " NO " ) 
CALL TOUCH<0,31,0,31. IX. lY) 

IX = IX/2 
lY = lY/2 

IFUX.GT. 10) WRITEC LU. 223) 

223 FORHAT< lOX" CURVE NOT PLOTTED") 

IF< IX. GT. 10 ) GO TO 15 
IF<IX.LE.10) MRITE( LU. 222) 

222 FORMATt /. "Curve D es i r e d . . . . U i 11 1 1 Fit On Pa pe r ? " 5X " YE S " 1 OX " H 0 " ) 
CALL TOUCH( 0.31. 0.31. IX. lY ) 

IX = IX/2 
lY = IY/2 

IF( IX . LT . 10 ) GO TO 23 
CALL CLEER 
WRITEC LU. 101 ) 

CALL T0UCH(0.31.0.31. IX. lY) 

IX = IX/2 
lY = IY/2 

IF< IX . LT . 15 ) ISAVF = 1 
IF< IX. LT. 15 ) IFLAG = 1 
23 CONTINUE 

WRITEC LU. 414 ) 

414 FORMATC 5X. "Curve Being Plotted") 

CALL FILTRCWS2) 

RETURN 

END 

SUBROUTINE TOUCHCIXL.IXH.IYL.IYH.IX.IY) 

INTEGER ENQ 
DIMENSION IC2) 
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EQUIVALENCE ( I A , I ( 1 > > . < I B. I ( 2 > > 

DATA ENQ/002400B/ 

4 CALL EXEC(2, 107B/ENQ.^1 > 

CALL EXEC<1, 107B, 1,-4) 

IX > IAND<I( 1),37B> 

IV « IAND(ISHIF( I(2),8)/37B> 

RETURN 

END 

SUBROUTINE FILTR(USl) 

DIMENSION USK 1 > 

DO 1000 ICl»li798 
IC2 - ICl -i- 1 
IC3 = ICl + 2 

IF(USKICl) .GE. 100.0)GO TO 1000 
DlFl :: USK ICl ) - USK IC2) 

DIF2 « USK ICl > - USK IC3) 

D1F3 = USK 1C2 ) - USK IC3) 

IF<ABS< DIFl ) -GT. 1 .0 AND. ABS< 0 I F3 ) . GT . 1 . 0 )WSK IC2 ) 
IF<< ABS<DIF 1 ) . GT . 1 . 0 ) .AND. < AB S < D I F 2 ) . GT . 1 . 0 ) AND 
< << D IFl . GT . 0. 0 ) .AND. < D I F 3 . L T . 0 . 0 ) ) .OR. 

<< DIFl . LT . 0 . 0 ) .AND. < D I F 3 . G T . 0 . 0 > ) ) ) U S 1 ( I C 2 ) = 
1000 CONTINUE 
RETURN 
END 
ENDS 


= USK ICl > 
USK ICl > 


Program JWDPL 


FTH4#L 

/ PROCRAH JUDPL 

CONHOH IDATE(8>, I TI HEC 3 > . IDC8C 1 44 > / I BUF( 40 >v LU < IDSA V< 8 >. I SA VF 
l/HEWD 

D1HEH8I0N lAXKll)^ XYUS). X Y2( 3 ) . Z Y T X T( 2 1 > , I S 0 A T( 8 ) 

DIHEHSIOH V81(800>,US2(800>,DEGl(i2>.DEG2(12>.OEG3(12>,DEG4(12> 
DiHENGIOH IYLAB< 8 ), IXLAB( 12>. IXLAB3( 2 >. NTIHE(4 > 

DIHEHSIOH IXLAB2(3)iOKPLT(3>.IXDATE<9>. IXTIT(21 > 

DIHEHSIOH 8KP( 8) 

DIHEHSIOH ILECU7 >< 1LEG2<14>> 1LEG3( 14 ) 

DIHEHSIOH HUHFB(2>. IPAR(5). NAME( 3 >. N AHEl ( 3 ) > NAHE2(3>. HAHE3<3) 
DATADEGi/0..90.il80.<270./3S0..90.,180..270..3S0..9 0.,i80..270./ 
DATA SKP/270 . , 180 . , 90 . .0 . ,-90. , -180. , -270 . ,360 . / 

DATA DEG2/90., 180. , 27 0. , 36 0. ,90. ,180. ,270. ,360. ,90. ,180. , 27 0., 
1360./ 

DATA DEG3/180., 270. ,360. ,90. ,180. , 27 0. ,36 0. , 90. ,180. ,2 70. ,3 60., 
190 ./ 

DATA 0EG4/2 70. ,360. ,90. ,180. , 27 0. , 36 0. , 90. ,180. ,270. ,3 60. ,90., 
1180./ 

DATA lLEGl/12, 2HHA, 2HSA, 2H -,2H H,2HSF,2HC / 

DATA XYl/0 . ,- .3, -. 6/ 

DATA XY2/0 . , . 3, . 6/ 

DATA ILEG2/26, 2HSP, 2HAC, 2HE , 2H S C , 2H I E , 2H N C , 2H E S , 

12H L,2HAB,2H0R,2HAT,2H0R,2HY / 

DATA IAX1/2,2H 2,2H 4,2H 6,2H 8 , 2H 1 0 , 2K 1 2 , 2H 1 4 , 2H 1 6 , 2H 1 8 , 2H 20 / 
DATA 1LEG3/26, 2HAE, 2HR0, 2HSP, 2HAC, 2HE , 2H E H , 2H V 1 , 2H R 0 , 
12HHH,2HEH,2HT ,2HDI,2HV./ 

DATA IYLAB/14, 2HAL, 2HTI, 2HT0, 2HDE, 2H <,2HKM,2H) / 

DATA HTIHE/5/ 

DATA IXLAB/21, 2HHI, 2HND, 2H D , 2H I R , 2H E C , 2H T I , 2H 0 N , 2H (,2HDE, 

1 2HGS,2H) / 

DATA IXLAB2/2, 2H-1/ 

DATA IXLAB3/1,2H) / 

DATA IXTIT/40,2H , 2H P 0 , 2H I H , 2H T , 2H M U , 2H G U , 2H J,2HII1,2HSP, 

1 2HHE,2HRE,2H U,2HIH,2HD , 2 H PR , 2 H OF , 2 H I L , 2 H E ,2HDA,2HTA/ 

DATA IYTIT/40, 2HCA, 2HPE, 2H K, 2HEN, 2HNE, 2HDY, 2H J,2HIW,2HSP, 

1 2HHE,2HRE,2H U,2HIH,2HD , 2 H PR , 2 H OF , 2 H I L , 2 H E ,2HDA,2HTA/ 

DATA lXDATE/16/ 

DATA HAHEl/2HttJ, 2HKS, 2HC1/ 

DATA HAHE2/2HfcJ, 2HKS, 2HC2/ 

DATA NAHE3/2H«<J,2HPT,2HH / 

C ** INITIALIZE LU DEVICE 
CALL RHPAR< IPAR) 

LU > IPAR< 1 > 

C CALL EXEC(22, 1 > 

LU » 7 

C ** OPEN DATE AND TIME FILE 
C CALL OPEH( IDCB, IERR,HAHE,0 ) 

C ** INITIALIZE PLOTTER 
CALL PLTLU(12> 


A- 169 


HEUD - 0 
IFl « 0 
IHAHE « 0 
ISAVF * 0 
IRDY « 0 
CALL CLEAR ~ 

C URITE( LU. 403 > 

C40S F0RHAT( //■****HASA/HSFC JIHSFHERE yiHD PROFILE PLOTTING" 

C 11X"PR0GRAH**«*" > 

C MRITECLUi 214 > 

C214 FORHATC z'* J i nspher* Uind Profile Data Dec i r ed ?" 5 X" UI ND SPEED" 

C 110X"yiND DIRECTION* ) 

C CALL T0UCH<0,lS.0il5< IX. IY> 

C IF( IX. GT. 9) GO TO 213 

C yRITE<LU.21£) 

C16 FORHAT</"Use Progran JVOPL For Rind Direction Plots") 

C yRITE( LU. 21 7 ) 

C17 F0RNAT</.* ***• jySPL **• TERHINATED *•*•"> 

C STOP 

215 CONTINUE 

yRITE<LU.102) 

102 FORNATC /. *J i nsphere Rind Profile Data D es i re d? ■ 5X * C APE KENNEDY* 
110X*P0INT NUGU") 

CALL TOUCHC 0. 13. 0. 13. IX. lY > 

IFdX.GT. 10) GO TO 71 
ICK = 1 • 

URITE< LU. 103 ) 

103 F0RNAT< /. 5X. "Cope Kennedy Date Des i r ed? " 1 OX" 1 96 4- 1 966“ 
19X*1967-1970* ) 

104 F0RNAT</. 10X*Point Nugu Dota Fori 1965-1970") 

CALL TOUCH! 0. 15. 0, 15. IX. lY ) 

IF<IX.LE.9> yRITE<LU. 105 ) 

IF<IX.LE.9) INANE = 1 
IFCIX.GT.9) yRITE<LU. 106 ) 

IFdX.GT. 9) INANE » 2 
IF< INANE. E8 . 2) GO TO 172 
DO 141KS1.3 
HANE<K) « NANEUK) 

141 CONTINUE 
GO TO 173 

172 CONTINUE 

DO 142 K > 1.3 
HAHE(K) > HAHE2(K> 

142 CONTINUE 

173 CONTINUE 

105 FORNAT! 7. 10X"Cape Kennedy Data For: 1964-1966") 

106 FORNAT! 7. 10X*Cape Kennedy Data For.’ 1967-1970") 

GO TO 72 

71 CONTINUE 

DO 171 J«l. 3 
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HAHE( J > - NAHE3( J > 

171 CONTINUE 

URITE< LU^ 104 > 

72 CONTINUE 
C URITE< LU^ 108 > 

C108 FORHAT< // > * J i Nsphtr • Uind Speed Oeta Being Processed") 

URITE< LU/ 400 > 

400 FORHATt /7, "TURN ON PLOTTER .... POSI TI ON PAPER .... TOUCH PANEL BHEN* 
IIX'READY") 

234 CALL T0UCH<0.15.0.1S. 1X> IY> 

IF( IX. GT. IS ) GO TO 234 
C THIS IS WHERE THE DISC FILE IS OPENED 
CALL 0PEH(IDCB.1ERR<HAHE>0> 

CALL CLEAR 
C WR ITE< LU< 907 ) 

C07 FORHAK /" ****PLOTTIHG HAS BEEN I N I T I AL I ZE D ** ** ‘ > 

941 CONTINUE 

69 IFLAG = 0 

CALL LLEFT 
CALL SFACTC 15. , 10 . ) 

CALL PLOT< 1 . , 1 .5, -3 ) 

C ** WRITE NASA LEGEND 

CALL PL0T<0 . .0 . / 3 ) 

CALL PL0T<-.5,-.93i3) 

CALL SYHB<-.5,-.95/.l,ILEGl,0./l) 

CALL PLOT<- . 5. -1 . 1. 3) 

CALL SYHB<-.5,-41.1. .08,ILEG2,0.,1) 

CALL PLOT<- . 5, -1 . 25/3 ) 

CALL SYHB<-.5/-1.25..08/ILEG3/0.,l> 

C *♦ THIS PORTION DRAWS Y-AXIS 
CALL PLOT< 0 . / 0 . / 3 ) 

CALL PL0T(0 . /O . , 2 ) 

CALL PLOTtO . . 5 . / 2 > 

DO 30 1=1,10 
A = 1/2. 

CALL PL0T<0 . , A,3 ) 

CALL PLOT< . 05, A, 2 ) 

8 = 1*2 

CALL HUNB<- . 3, A, . 1, B, 0 . , -1 ) 

30 CONTINUE 

CALL SYMB<- . 45 , 1 . 9, . 10, 1 YLAB, 90 . , 1 ) 

C ** THIS PORTION WRITES HEADERS AND LEGEND 
CALL SYNB<3.5, - 1 . 1 , . 1 0, IXLAB , 0 . , I ) 

IF< INANE . Efi . 0 ) CALL S Y NB < 2 . 3 , 6 . 0 , . 1 2 , I X T I T . 0 . , 1 ) ' 

IF<INANE.GT.O) CALL S YHB< 2 . 3, 6 . 0 . . 1 2 , I Y TI T , 0 . , 1 ) 

C «* THIS PORTION READS THE FIRST WSl DATA ARRAY 
IF(IFl.EQ.O) CALL RWS2< WSl , IFLAG , I QDS > 

IFCNEWD .EQ. 1 > GO TO 941 
IFl = 1 

1F< ISAVF .HE . 1 ) GO TO 129 
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DO 128 

IDATE< J ) = IDSAVC J ) 

128 CONTINUE 

IF< ISftVF. EQ . 1 ) ISAVF = 0 

129 CONTINUE 
IFLAG =0 

DO 571 KL=1,8 
KP = KL * I 

IXDATE(KP) = IDATECKL) 

571 CONTINUE 

CALL SYMB(4.,5.7O..12.IXDATE^0.,1) 

X = 0. 

XYll = XYK 1 ) 

XY22 = XY2< 1 ) 

XYFLG = 1 

C ** THIS PORTION DRAWS THE X AXIS ***♦•*•*♦ 
95 CALL PLOTCO . ,0 . . 3 ) 

CALL PLOT< X, XYll , -3 ) 

XX=0 . 

DO 456 1=1/790 

IFCMSK I ) .GE . 1 000 . ) GO TO 456 
XX = AMAXK XX, MSK I )) 

456 CONTINUE 

XX=< XX + SKP< IQDS ) )/l 80 . 0 

XX = AINT<2.0*<XX+0. 499999 99 )>/2.0 

CALL PLOT( XX , 0 , , 2 ) 

HXX = INT<2 . 0 * XX) + 1 
DO 35 I=1/NXX 
A = < I-l )/2 . 

D = DEG1< I ) 

IF< IQDS .EQ. 1 ) D = DEG2< I ) 

IFUQDS . EQ . 2 ) D = DEG3< I ) 

IF< IQDS . EQ . 3 ) 0 = 0EG4C I ) 

IF( IQDS . EQ. 4 ) D = DEGHI) 

IF< IQDS .EQ . 5 ) D = DEG2< I ) 

IF< IQDS . EQ . 6 ) D = 0EG3< I ) 

IF< IQDS EQ. 7 ) D = DEG4( I ) 

IF< IQDS .EQ. 8 ) D = DEGK I ) 

CALL PLOTC A, 0. , 3 ) 

CALL PLOT< A, .05,2) 

B = A - . 05 

CALL NU«B<B, -. 15/ . 1 /D, 0. ,-l ) 

35 CONTINUE 
8 = 0 . 

CALL PL0T<0. /XY22/-3) 

IF(US1( 1 ) -GE . 1000 . ) GO TO 642 
A=(US1<1)+SKP(IQDS))/180. 

B= B + .00625 

CALL PLOT( A , B, 3 ) 

642 CONTINUE 
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H =. 1 
JFLG ■ -1 
DO 36 I«2,790 
B * B + .00625 

IF<US1( I ) .GE . 1000 . ) GO TO 64*< 

A « (WSK I ) + SKP< IQOS) )/iBO 
XC > ABS( WSK I >-USl(H > > 

IF( JFLG.NE.O ) CALL PL0T(A/Bi3> 

JFLG=0 

CALL PL0TCAiB<2) 

CC= B 
H = I 

643 COHTIHUE 
36 CONTINUE 

C = A - .25 

D = CC+ .05 

NT 1HE( 2 ) = 1TIME< 1 ) 

NT IME< 3 > = 1 TIME< 2 ) 

NT IHE< 4 ) = ITIME< 3) 

CALL SYHBCC.D. .08-HTINE/0. , 1> 

CALL RUS2<yS2. IFLAG.IQDS) 

IFCHEUD .EQ. 1 ) GO TO 941 
IFUFLAG. EQ .0) GO TO 70 
DO 96 I*li790 
USK I ) - US2< I ) 

96 CONTINUE 

GO TO 69 
70 X = XX 

IF<XYFLG. EQ . I ) XYll = XY1<2> 

1F(XYFLG. EQ . I ) XY22 = XY2<2) 

IF<XYFLG.EQ .2) XY22 = XY2<3) 

IFCXYFLG. EQ . 2) XYll = XYK3) 

IF< XYFLG . EQ . 3) XYll = XY1(1> 

1F<XYFLG. EQ . 3) XY22 = XY2< 1 > 

IFCXYFLG. EQ . 3) XYFLG = 0 
IF<XYFLG. EQ . 3) CALL PLOT< 0 . . . 6/ -3 ) 

XYFLG = XYFLG + 1 
DO 80 1=1,790 
USK 1 ) = US2( I ) 

80 CONTINUE 

GO TO 95 

999 CALL URITE 

C CALL EXEC(22,0> 

CALL CLOSE( IDCB, lERR) 

END 

SUBROUTINE RUS2( US2 , I FLAG, I QDS, DSHF > 

conn ON IDATE<8 >, ITIHEI 3), 1DCB( 144>. IBUF<40 >, LU, IDSAV(8 ), ISAVF 
1, HEUD 

DIMENSION US2<800) 
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DATA IBLK/2H / 

ICF 0 

IF(HEyD .EQ. 1 > GO TO 942 
15 IK = 1 

DO 51 K = 1,100 
KK » K*8 

READ(8i*> (US2(IJ ), U^IK.KK) 

IK = IK + 8 
51 CONTINUE 

CALL READFC IDCB, lERR, IBUF) 

CALL CODE 

READ(IBUF,300><1DATE(NN>,HH=1,8>,<ITIHE(NK>,NK-1,3) 

300 FORHAT< 8A2, 3X, 3A2 ) 

IF< IDATEC 1 ) . EQ . I6LK ) GO TO 20 

DO 89 J=1 ,8 

IDSAV( J ) = IDATEt J ) 

89 CONTINUE 

IF< ICF . EQ . 1 ) GO TO 953 
IF< IRDY EQ. 0 ) GO TO 45 
CALL CLEAR 
«RITE< LU, 580 ) 

580 FORNAT(/,"DO YOU WISH TO TERHINATE P R OG R A N ? * 1 0 X • Y ES " 1 0 X" HO" > 

CALL TOUCH< 0 , 1 5, 0 , 15, IX, lY ) 

C IF(IX.LT.IO) URITEtLU, 349) 

IF( IX . LT . 10 ) STOP 

C49 FORHAT< /“****PROGRAM J IMPL HAS BEEN TERHI NATED****" ) 

MRITEC LU, 101 ) 

101 FORHATC // “CHANGE PLOT PAPER TOUCH PANEL TO CONTINUE") 

CALL TOUCH( 0 , 1 5, 0 . 1 5, IX, lY ) 

IF< IX . LT . 15 ) IFLAG = 1 
45 CONTINUE 

IRDY = I 

WRIT E<LU, 100) <IDATE(NK),NK=1,8) 

100 FORHAT< // "Hew Date isi "8A2) 

C RETURN 

WR ITE< LU, 940 ) 

940 FORHAT< /, “0 i ff erent Date 0 es i re d?" 1 0 X " YES " 1 0 X“ NO" ) 

CALL TOUCH( 0 , 1 5, 0 , 1 5, IX, lY ) 

IF(IX.GT.S) GO TO 942 
URITE< LU, 951 ) 

951 FORHAT< /"ENTER NUMBER OF CURVES SKIPPED? _“) 

READ<LU,*> ICURS 
NFB = ICURS - 1 
IFB = NFB 
NFB = NFB+100 
CALL PTAPE<8,0,HFB) 

CALL POSNT( IDCB, lERR, IFB,0 ) 

ICF = 1 
GO TO 15 
953 CONTINUE 
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942 CONTINUE 
NEUO = 0 
ISAVF = i 
20 CONTINUE 

URITE( LU/ 301 X ITIHE(HK ). NK=li 3> 

301 FORHATC //‘T i «e of Curve is: • 2fl2 . ft 1 / SX" PI ot De s i r ed? • 1 OX • YES* 
lOX'NO" ) 

CALL TOUCH< 0 . 1 5. 0 . 1 Si IX. lY > 

C IFdX.GT.lO ) URITE( LU.223) 

C23 FORHAT< 10X*CURVE NOT PLOTTED*) 

IF( IX. GT. 10 ) GO TO 15 

IF(IX.LE.IO) URITE< LU> 222) 

222 FORNAT< *Curve D es i r e d . . . . U i U It Fit On Pa pe r ? “ 5X “ YE S * 1 OX “ HO * ) 
CALL T0UCH<0,15i0.15i IX. lY) 

IF< IX . LT . 10 ) GO TO 23 
CALL CLEAR 
URITE< LUi 101 ) 

CALL TOUCH< 0 , 1 5. 0 , 1 5. IX. lY ) 

IF< IX. LT. 15 ) ISAVF = 1 
IF< IX . LT . 15 ) IFLAG = 1 
23 CONTINUE 

C HRITEC LUi 414 ) 

C14 F0RHAT<5Xi*Curve Being Plotted*) 

CALL FILTR<US2ilQDS.DSHF) 

RETURN 

END 

SUBROUTINE T OU CH ( I X L . I XH , I Y L / I Y H . I X , I Y ) 

INTEGER ENQ 
DIMENSION I<2) 

EQUIVALENCE ( I A . I ( 1 ) ) . ( I B . I< 2 ) ) 

DATA ENQ/002400B/’ 

4 CALL EXEC(2. 107B i ENQ. - 1 ) 

CALL EXEC< 1 i 107B. I, -4 ) 

IX = IAND( ISHIF< IB. -8 )> IB) 

IX = IOR< IAND< ISHIF<Ifti-3).2B)i IX) 

IX = IOR< IAND< ISHIF<IA,-1).4B), IX) 

IX = IOR< lANDC ISHIF< lA . 1 ). lOB ). IX) 

1F<1X.LT.IXL .OR. IX.GT.IXH)GO TO 4 
lY = I AND( ISHIF( IB. -12 ). IB ) 
lY = IOR< IAND< ISHIF<IBi-10),2B)i lY) 
lY = IOR< IAND< ISHIF<IB,-8)i4B), lY) 
lY = I0R<IAND<ISHIF<IB.-6)il0B)iIY) 

IFdY.LT.IYL .OR. IY.GT.IYN)G0 TO 4 

RETURN 

END 

SUBROUTINE CLEAR 
INTEGER RSFF 
DATA RSFF/017014B/ 

CALL EXEC<2. 107B.RSFFi-2) 

RETURN 
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END 

SUBROUTINE F !LTR< US 1 / I QDS. DSHF ) 

DIMENSION USKl) 

H = 1 

DO 100 1=2.790 

IF<WSl< N) .GT . 1000 . > GO TO 50 

IF<WSKI>.GT.100 0.) GO TO 100 

IFC ABS< USK N >-USl< I ) ) . LT . 1 80 . ) GO TO 50 

IF<WS1< I ) .GT .USK H) )G0 TO 40 

WSK I ) = USK I ) + 360 . 0 

GO TO 50 

40 WSK I ) = USK I ) - 3U . 0 
50 H = I 

100 CONTINUE 
RUIN = 10000. 

00 101 1=2.790 

RNIH = ANIHKRNIH.USK I ) > 

101 CONTINUE 

IF<RMIN . GT . -270 . . AND . RHIN . LE . -1 80 . ) IQDS = 1 
IFCRNIN .GT. -180. . AND. RMIN. LE, -90 . ) IQDS = 2 

IFCRMIN .GT. -90 . . AN D . R ft I N . L E . 0 . ) IQDS = 3 

IF<RMIH .GT.O . . AND . RMI N . LE . 90 . > IQDS = 4 

IFCRMIN .GT. 90. . AN D . R M I N . L E . 180.) IQDS = 5 

IFCRMIN .GT. 180 . . AN D . R M I N . L E . 27 0 . > IQDS = 6 

IFCRMIN .GT. 270 . . AN D . R M I H . L E . 1 0 0 0 . > IQDS = 7 
IFC RMIN .GT . -360 . .AND. R M I H . L E . - 2 7 0 . ) IQDS = 8 
IFC IQDS .EQ. 1 ) DSHF = 270 . 

IFC IQDS .EQ. 2 ) DSHF = 180 . 

IFC IQDS .EQ . 3 ) DSHF = 90 . 

IFC IQDS EQ. 4 ) DSHF = 0 . 

IFC IQDS .EQ . 5 ) DSHF = -90 . 

IFC IQDS -EQ . 6 ) DSHF = - 180 . 

IFC IQDS .EQ . 7 > DSHF = -270. 

IFC IQDS EQ. 8 ) DSHF = 360 . 

RETURN 

END 

SUBROUTINE IQDCPCIQD.A) 

IFC IQD . EQ . 2 . AND . A .GT . . 5 ) A = A - .5 

IFC IQD . EQ .2 . AND . A LE..5) A = A + 1.5 

IFCIQD .EQ. 3 .AND . A. LE . 1 . )A = A+1 . 

IFCIQD .EQ. 3 . AND . A. GT . I . ) A = A-1. 

IFCIQD .EQ. 4 . AND . A . LE . 1 . 5)A=A+ . 5 

IFCIQD .EQ.4.AND.A.GT.1.5)A=A-1.5 

RETURN 

END 

END$ 
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PROGRAM JIHPS 

DIMENSION X<4),Y<4),XX<10),YY<800>,IHEAD(20),WSK 80 0> 
DIMENSION XTIC< 12 )i XT1CK2 ), YT I C< 42 > , YTI C 1( 2 ) , IXNUM< 6 ) 
DIMENSION IPAR<5> 

DIMENSION ITIME(18>,IERS(32>.JUSPL(3>>ILINE(32> 

DIMENSION IXLEG( 9 >, JIMFK3 ) 

DIMENSION IDATE< 8 ), YLAB< 10 ), YALT( 8 )/ XNUM< 12) 

INTEGER YLAB/YALT 
REAL LL 

DATA IERS/32*20040B/ 

DATA JUSPL/2HJUi 2HSPi 2HL / 

DATA J IMF1/2HJ I. 2HMF/ 2H1 / 

DATA 1 TIME/2H1 3, 2H06/ 2Hz . 2H1 4. 2H3 1 / 2Hz . 2 H 1 8 . 2 HO 0 / 2 Hz ^ 
12H17.2H31 ,2Hz , 2 H 1 9 , 2 H 00 , 2 H z , 2 H 22 , 2 H 00 , 2 H z / 

DATA X/64 . , 1 64 . . 64. ,64 ./ 

DATA YTICl/62. ,66 ./ 

DATA YTIC/152., 152., 176., 176., 200., 200., 224., 224., 248., 248., 

1272.. 272. .296. .296. .320. .320. .344. .344. .368. .368./ 

DATA IXNUM/2H 0 , 2 H 1 0 , 2 H20 , 2 H3 0 , 2 H4 0 , 2 H5 0/ 

DATA IXLEG/2HSC, 2Hal, 2Har, 2H «,2Hin,2Hd , 2HS p , 2 Hee , 2Hd / 

DATA XNUM/5 6. , 56. ,76. , 76. ,96. ,96. ,116. ,116. ,136. ,136., 

1156. . 156. / 

DATA XTIC/64.,64.,84.,84.,104.,104.,124.,124.,144.,144., 

1164. . 164./ 

DATA XTICl/1 26 . , 1 30 ./ 

DATA IHEAD/2HCa, 2Hpe, 2H K, 2Hen, 2Hne, 2Hdtj, 2H J , 2 H i n , 2 Hsp, 2 Hh e , 
12Hre,2H y,2Hin,2Hd , 2 H Pr , 2Hof , 2 H i I , 2 H e ,2HDa,2Hta/ 

DATA YALT/2HA ,2Hl ,2Ht ,2Hi ,2Ht ,2Hu ,2Hd ,2He / 

DATA Y/128. , 128. , 128. ,368./ 

DATA XX/50., 75. ,150. ,175. ,2 00. ,250. ,275. ,300. ,3 50. ,360./ 

DATA Y.Y/5 0.,. 100. ,150. ,175. , 24)0. ,300. , 32 5. ,35 0. , 36 0. ,368./ 

DATA IDATE/2H , 2H D,2Hec,2H 2,2H9,,2H 1,2H96,2H4 / 

DATA YLAB/2H 2,2H 4,2H 6,2H 8 , 2 H 1 0 , 2 H 1 2 , 2 H 1 4 , 2 H 1 6 , 2 H 1 8 , 2 H20 / 

C ** INITIALIZE LU DEVICE 
CALL RMPAR< IPAR) 

LU = IPAR<5) 

C ** THIS PROGRAM IS TO TEST XPLIB LIBRARY OF SUBROUTINES 
C ** WRITTEN FOR THE PLASMA SCOPE 

C ** CALL GRAF TO INITIATE PLASMA SCOPE FOR GRAPHING 
CALL GRAF<0) 

C ** CALL CLEAR TO CLEAR PLASMA SCOPE 
1 CALL CLEAR 

C ** CALL SETOR<XORG,YORG ) TO I N I T I AL I ZE X , Y ORIGIN 
IFG = 0 

CALL SETOR< 0 . , 0 . ) 

C ** CALL SETSCI XSCAL, YSCAL ) TO SET SCALE FACTORS 
CALL SETSCC 1 . , 1 . ) 

C ** CALL LINE< X, Y ,NXY , MODE ) TO PLOT POINTS 
C X AND Y = THE X,Y CO-ORDINATES 
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C ** HXY = THE HUHBER OF POIHTS TO BE PLOTTED 
C ** NODE » 0 SPECIFIES ft WRITE^ » 1 SPECIFIES AH ERASE 
C ** CALL POIHT<X , Y. NXY , NODE ) SANE AS ABOVE EXCEPT PLOTS A LIKE 
XSHF = -64. 

71 CALL LIHE<X- Y, 2, 0 ) 

DO 70 J=1 ,6 

I = < J- 1 )*2 + 1 

CALL LINE<XTIC<I ),XTIC1,2,0> 

CALL CHAR<XNUH(I><110./0iIXNUN(J)i2/0,0> 

70 CONTINUE 

IF< IFG . GT . 0 ) GO TO 52 
CALL LINE(X<3),Y<3),2,0) 

VLB = Y< 1 ) - 8 . 

Y N N = Y < 1 ) 

XLB = X< 1 ) - 24 . 

DO 10 1=1,10 
YLB = YLB + 24. 

YHH = YHN + 24. 

J = < I-l )*2 + 1 

CALL CHAR<XLB , Y L B , 0 , Y LA B( I ) , 2 , 0 , 0 ) 

CALL LINE< YTICl, YTIC< J >, 2, 0 ) 

10 CONTINUE 

C ** PRINT SCALAR UIND LEGEND 

CALL CHAR <175. ,40.,0,IXLEG,18.0,0) 

C ** PRINT ALTITUDE LEGEND 
YAL = 360. 

DO 20 I =1,8 
YAL = YAL - 24. 

CALL CHAR<8. , YA L , 0 , Y A L T < I ) , 2 , 0 0 ) 

20 CONTINUE 

C ** PRINT HEADER 

CALL CHAR <100. ,470. ,0, IHEAD,40,0,0) 

CALL CHAR<200.,445.,0,IDATE,16,0,0) 

C ** RESET ORIGIN TO PLOT LINE 
52 CONTINUE 

CALL SETOR< XSHF, - 128 . ) 

C CALL SETSC< 3.2,1.) 

CALL SETSC< 1 . , 1 . ) 

C CALL LINE<XX,YY, 10,0) 

LL = 0 . 

DO 40 L=l,800 
LL = LL + .3 
YY<L) = LL 
40 CONTINUE 

IK = 1 

DO 30 K=1 ,100 
KK = K*8 

READ<8,*) <US1<IJ),IJ=IK,KK) 

IK = IK +8 
30 CONTINUE 


A-179 



o o o o o o 



CALL FILTR< «S1 ) 

H = 0 

DO 50 L=li797/4 

IF(«S1( L) .GT . 100 . ) GO TO 50 

H = N + 1 

WSK N> = USl (L . 

VY<H > = YY( L ) 

C CALL POINT(WSl(L)/yY(L>, 1.0) 

50 CONTINUE 
CALL LIN£<WS1/ YY. N. 0) 

N J = < IFG*3 ) + 1 
R = YY( N) + 4. 

CALL CHAR(ySlCH).R/0.ITIME<NJ).6,0,0) 

IF<IFG,E0.O> CALL S ETOR( -1 2 4 . . - 1 1 0 . ) 

IF(IFG.EQ.l) CALL SETOR< -1 84 . . -92 . > 

X< 1 ) = X< 1 ) + 60 . 

X< 2) * X< 2) + 60 . 

1 ) = Y< I ) - 22 . 

Y< 2) = Y< 2) - 22 . 

IF(IFG.EQ.O) CALL S£TOR( -60 . , 22 . > 

IF(IFG.EQ.l) CALL SETOR( -1 20 . , 44 . > 

IF(IFG.EQ.2) CALL SETORC -1 80 . , 0 . ) 

IF<IFG.EQ.3) CALL S ET 0 R< -2 4 0 . . 2 2 . ) 

IF(IFG.EQ.4) CALL SETORC -300 . . 44 . ) 

IFdFG.GE.S) GO TO 51 
IFG = IFG + 1 . 

XSHF = XSHF - 60 . 

GO TO 71 

51 CONTINUE 

C CALL LIHE(«S1. YY, 800.0 ) 

C CALL TOUCH TO SEE IF USER DESIRES TO CONTINUE OR TERMINATE 

CALL HGRAF 
CALL GRAF<0) 

345 CALL DREAD< J IMFl . 2, ILINE ) 

CALL CHAR<8.0.16..0,ILINE.64.0.0) 

CALL INC 1 . J TYPE, 0 . . 0 . , 0. 0. 0 . 0 , 31 ,0 , 31 I IX. I Y) 

IX = IX/2 
lY = IY/2 

IFC IX . LT . 14 )G0 TO 1 

CALL CHARC 8 . , 16 . . 0, lERS. 64. 0. 0 ) 

CALL DREADC U IHFl , 3. ILINE ) 

CALL CHARC8..16..0.ILINE.64.0.0) 

CALL IN<1.JTYPE.O..O..O.O.O,0.31,0,31.IX.IY) 

IX = IX/2 
lY = IY/2 

IFCIX.lt. 8) GO TO 344 
REUIHD 8 
CALL NGRAF 
CALL EXECC9. JWSPL ) 

CALL GRAFCO) 
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GO TO 345 

C ** CALL NGRAF TO RE-ESTABLISH PLASHA SCOPE FOR TOUCH MODE 
344 CALL CLEAR 
CALL HGRAF 
C *«> REHIND TAPE 
BEHIND 8 
STOP 
END 

SUBROUTINE FILTR(USl) 

DINEHSION HS1(1> 

DO lOOD IC1»1<798 
IC2 » ICl « 1 
1C3 « ICl + 2 

IF<HSKIC1> .GE. 100.0>G0 TO 1000 
DIFl » USK ICl > - HSK IC2) 

DIF2 = HSK ICl ) - HSK IC3) 

DIF3 = US1CIC2) - HSKIC3) 

IF<ABS(DIF1 ) .GT. 1 .0 .AND. ABS < D I F3 > . G T . 1 . 0 >H S 1 ( I C 2 > = USKICl) 
IF<< ABS<DIF1 ) . GT . 1 . 0 ) .AND. < AB S ( D I F 2 ) . G T . 1 . 0 ) .AND. 

< < < D IFl . GT . 0 . 0 ) .AND. < D I F 3 . L T . 0 . 0 > ) .OR. 

< < D IFl . LT . 0 . 0 ) .AND. < D I F 3 . G T . 0 . 0 ) ) ) ) « S 1 ( I C 2 > = HSKICl) 
1000 CONTINUE 
RETURN 
END 

SUBROUTINE CLEAR 
INTEGER RSFF 
DATA RSFF/017014B/ 

CALL 'EXEC<2.10 7B>RSFF,-2) 

RETURN 
END 

SUBROUTINE DREAD<NAMEF,LNU«,ILINE) 

DIMENSION NAMEF(3).IDCB<276),IBUF<40>,ILIHEC32) 

CALL OPEN<IDCB,IERR/NAME.F,0> 

LOOP = LNUM - 1 
DO 10 1=1. LOOP 
CALL BLANK! IBUF. 40) 

CALL READF! IDCB. lERR. IBUF) 

10 CONTINUE 

CALL BLANK! IBUF. 40) 

CALL READF! IDCB. lERR. IBUF) 

CALL CODE 

READ! IBUF. 100) ! I L I NE ! I ) . I = 1 . 32 ) 

100 F0R«AT!32A2) 

CALL CLOSE! IDCB. lERR) 

RETURN 

END 

SUBROUTINE 6 LA HK ! 1 6 UF . 1 1 ) 

DIMENSION IBUF!40) 

DATA IBLK/2H / 

DO 10 1=1.11 
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10 IBUF(I) « IBLK 
RETURN 
END 
END* 
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PROGRAM SKEUT 

DIMENSION I ALT< 31 , 3 IDIR< 31 . 3 ) , SPEED< 31 , 3),TEMP(31.3),PRESS(31,3) 
DIMENSION SURDEN<6),V<31 ). ISWR(20>,DPTEMP<31,3),PTEMP<31,3) 

DIMENSION Q< 30 ), A<23 )i C< 23 ),B(23 E( 15)/F< 4, 4) . G< 4, 4 >, K< 23) 

DIMENSION y(31,5),X(40,5),LHEAD(40,80).ALT<31.3> 

C CALL DATE 

P9=3 . 14159 
M = 0 

I SUR< 1 )=0 
IS«R<2 )=0 
ISyR<3 )=0 
ISUR<4 ) = 0 
ISyR<5 )=0 
ISyR<6 )=0 
ISyR< 7 )=0 
I SyR< 8 )=0 
ISWR< 9 )=0 
isyR< 10 )=o 
isyRU 1 )=o 

I SUR< 1 2 ) = 0 
ISURC 15 )=1 
61 IUNIT*5 

IF < ISUR( 1 ) .EQ. 0) IUNIT = 1 

88 A<1)*0 

N = 1 

IF < ISWRC 8) .EQ. 1 ) GO TO 140 
yRITE (6,9010) 
i DEFINITION OF TERMS! 

TEHP< I ALT, N )--TE«PERATURE ; PRESS< I ALT , N )--FRESSURE; DP TE H P< I A L T , N ) - -H UM I D I T Y 
C 

C "f*LOAD DATA** 

ITIMES=5 

CALL I0HED< LHEAD, ITIMES) 

C READ < 8 , * ) N 

READ (8,9860) LTIM,LDAY,LMOH,LM,LYEAR 
ITIMES=19 

CALL IOHED( LHEAD, ITIMES) 

C 

yRITE ( 6, 9015 ) 

READ ( 1 ,9850 ) IFNO 
CALL PTAPE (8, IFNO, 0 ) 

C 

T2=9999 
I TII1ES = 3 

CALL I OHED( LHEAD , IT IMES ) 

8000 READ ( 8,9865 ) I S T I M , I S D A Y , I SM ON , I S M , I S Y E A R 
IF( I SDAY . EQ . 0 ) GO TO 8000 
yRITE( 12) -1,1, 1000 ,9000 

yRITE(12,8040)175,0,0,200,ISTIM,ISDAY,ISHON,ISM,ISYEAR 
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ITIf1ES = 2 

CALL I0HED< LHEAD. ITIHES) 

READ < 8.9870 ) I AL T< 1 . H ) . I D I R( 1 , N ) . SP E ED ( 1 , N ) . T E HP < I , N ) , 

1DPTEMP< li N). PRESS< 1 .H ).SURDEH<N ) 

DO 120 1=2.30 

115 READ < 8.9875 ) I A L T< I . N ) . I D I R< I . N ) . SP EED < I , N ) . T E HP < I . N ) . 

1DPTEHP< I , N ) . PRESS< I , H ) 

CALL EXEC< 1 3 . 8 . lEQT ) 

IEQT = IAND< IEQT.200B ) 

IF < lEQT ,GT . 0) GO TO 140 
IF <IALT<I.N) .LT. 10) GO TO 115 
IF <IALT<I.H) .GT. 10000) GO TO 115 
JARAY=I 

120 CONTINUE 

C 

C 

140 IF <IUHIT .EQ. 2 .OR. lUNIT . EQ . 3) U R I TE < 6 . 40 2 0 ) 

4020 FORMAT <“NEED JUMP") 

C !N DATA SET NUMBER; L MO N . L D A Y , L YE A R . LT I M LAUNCH DATE7TIME 

C i 

C ! IST1M--S0UHDIHG TIME; T 2 -- PR E D I CT I OH TIME 
C CONVERTING SOUNDING TIME FROM ZULU TO EDT - AM . PM 
ISTIM=lSTIM-400 \ 

IF <ISTIM .GT. 0) GO TO 250 
I8TIM=2400-ABS<ISTIH) 

ISDAY=ISDAY-1 

250 IF <ISTIM .GE. 1300) GO TO 260 

IF CISTIM .GE. 1200 .AND. ISTIH .LT.1300) GO TO 270 
GO TO 280 

260 ISTIM=ISTIM-1200 
270 CONTINUE 
280 CONTINUE 

C i SURDEN< N )=SURFACE DENSITY 
C 

C CONVERT DATA TO METRIC, SORT DATA BY lALT. CAL POT T EM P = P TE M P< I A L T . N ) 


DO 590 I=1.JARAY 

C 1 ENGLISH TO METRIC 

ALT< I. N )=IALT< I. N > 

ALT< I . N )= . 3048*ALT< I , N ) 

SPEED< I , H >= . 515*SPEED< I. N) 

C : SORT 

509 L=I 

510 IF <L .EQ . 1 ) GO TO 590 

IF < ABS< ALT< L. N ) ) .GT. ALT<L-1.N)> GO TO 590 


ALT< 31 , N) = ALT< L-1 .N ) 

ID IR< 31 , H )=I DIR< L-1 .H ) 
SPEED<31.N)=SPEED<L-1.N) 
TEMP<31 ,N ) = TEMP< L-1 ,H ) 
PRESS< 31. N > = PRESS<L-1 . N ) 
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DPTEHPC 31 ) = DPTEHP<L-1.H) 
ALT< L-1 ,N )=ALT< L , H) 
I0IR<L-1.N)=IDIR<L,H) 
SPEED( L-l .H ) = SPEED< L. N > 
TEt1P< L-1 , N) = TE«P< L, N) 
PRESSC L-1 .N )=PRESS< L, N > 
DPTEMP<L-1,H ) = OPTEMP<L,M) 
ftLT< L/ N ) = ALT( 31 , H > 

IDIR<Li N) = IDIR(31 ,N ) 
SPEED(L,N)=SPEED(31.H) 
TEMPC L> N)=TEMP<31 ,H > 

PRESS( L .N ) = PRESS( 31 ,N ) 
DPTE«P( L. N) = DPTEMP< 31 , H ) 

L = L- 1 

570 GOTO 510 


590 CONTINUE 

C CALCULATE POTENTIAL TEMPERATURE COEG K) PTE«P<ALT,H) 

DO 690 I=i,JARAY 
C ALT< I. N ) = ABS(ALT< I, N) ) 

PTEWPC I , N ) = < TENPt I, N > + 273 . 1 5)f< < 1000 7PRESS< I i N ) >*■» . 288 > 

690 CONTINUE 

C PRINT METEOROLOGICAL DATA 

725 J*J9 

C IF CISUR<12) .EQ. 0) WRITE (6/*) 'CTR PRINT* 

C IF <ISWR<12) .EQ. 0) WAIT < 15000 ) 


WRITE <6i9220) 

WRITE < 6< 9140) 

WRITE < 6. 9140) 

WRITE < 6i 91 40 ) 

IF <ISWR(15) .EQ. 0) WRITE <6,9230) 

IF <ISWR<15) .EQ. 1) WRITE <6,9240) 

WRITE <6,9250) LTIN, LDAY, LMOH, LM, LYEAR 
WRITE < 6, 9140) 

WRITE <6,9260) ISTIM, ISDAY, ISMON, ISM, ISYEAR 
WRITE <6,9270) T2 
E< 6>=. 66355 

WRITE <6,9280) N, SURDEH<N) 

WRITE <6, 9140) 

WRITE <6, 9290) 

WRITE <6,9300) 

DO 850 I»1,JARAY 

SPEED< I,H)=INT<SPEED< I,N)*10)/'10 

IALTF=ALT<I,H)/.3048+.5 

IALT< I , N)=ALT( I, H )♦ .5 

APTEMP = PTEMP< I ,H )-273 . 15 

WRITE <6,9310) I, lALTF, IALT<I,N>, IOIR<I,N), SPEED<I,H), TEMP<I, 
IK ) , APTEMP, OPTEMP< I , H ) , PRESS< I , H ) 


850 CONTINUE 
C 

C PLOT SKEW T , LOG P DIAGRAM 
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c 

c 


SET «T<-1 F.IOSONB) S <“82.5. F, 500HB) 

IPEN— 1 
DO 9D0 I«1<3D 

IF<PRESS(I<H).LT.945) GO TO 900 

IR-142 . 8*(TEHP<I <H)4273. 1S>-10831 . *ALOCT( PRESS< 1 ^ H ) >-3608 . 

I Y«-346 23 .*ALOGT( PRESSCI <N) >'•-10 4 603. 

URITE< 12) IPENi 1 . IX, 1 Y 
IPEH-1 
900 CONTINUE 

URITE< 12> -1 ,-li 100.-150 
URITE <12.9031> 100,0.0,125 

9031 FORHAT( 415. 7HAHBIEHT> 

PAUSE 

IPEH— 1 
DO 925 1*1,30 

IF(PRES3< I, N >. LT . 54S> GO TO 925 

IX*142 . 8*(0PTEHP( I, N > + 273. 1S>-10831 . *ALOCT( PRESS( I, H > >-3668 . 

I Y*-34 623 .«ALOCT( PRESS( 1 ,N > >+10460 3. 

URITE< 12> IPEH,1, IX, lY 
IPEH*1 

925 CONTINUE 

URITE <12,9032> 100,0.0.125 

9032 FORHAT( 4IS. 9HDEU POIHT> 

950 URITE<12> -1.1.9999,9999 

OELP-1000 
00 975 1*1,30 

IF<PRESS< I,N).LT .545) GO TO 975 

IF(PRESS< l.N >. NE . DELP > GO TO 975 

DELP=DELP-SO 

IZ=3 . 28084+1 ALT( l.N) 

ir*-3<6Z3.+AL0GT<PRESS<I,M>>+I04603. 

WRiTct; ie7-i, 

iiRlTEii2,'3o30> 75,0,o, 100,12 
9030 413, 15, 3H FT) 

WRITE< 12>-1 , 1, 850,1 V 
URIT£< 12) 1 . 1,900.1V 
URlTEt 12)-1 , 1.875.IY 
URITE<12,9020> 75.0,0,I00,IALT(I,N) 

9020 FORHAT( 415, 15, 7H HETERS) 

975 CONTINUE 

UR1TE<12> -1. 1,250,8500 
UR1TE( 12. 9021 > 100,0,0,125 

9021 FORHAT< 41 5, SHALT I TUOE > 

HRITE< 12) -1.1 ,9999.9999 

9010 FORHAT <*DATA NUN BE R$ * , ■• 0" , " » • > 

9015 FORHAT <‘‘(fcdBENTER FILE HUHBER IN 2 DIGIT I FORHATo > 

9140 FORMAT <70X> 

9190 FORHAT <"======== =====x= »================================ ====“) 
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9230 FORMAT <7X, "SPACE SHUTTLE LAUNCH FROM KSC") 

9240 FORMAT (“TITAN IIIC LAUNCH FROM KSC“ > 

9250 FORMAT < " d CL au n ch t i ne : ” . 1 8 . 9X . “ Da t e ! " , 1 2, 1 X , 2A2, 1 X> 14 ) 

9260 FORMAT (“ TIME OF SOUNDING! “ , I 8/ 4X , 12 / 1 X , 2A2 , IX / I 4 ) 

9270 FORMAT (" TIME OF PREDICTION! “,I4) 

9280 FORMAT (“DATA SET: “ . I 2/ 13X / “ SURFACE DENS I TY( GM/N**3 >" . F8 . 2 ) 

9290 FORMAT (“|«.dBLAYER ALTITUDE DIRECTION SPEED TEMP POT-TEMP 
lt«.dB D P TEMP PRESSURE") 

9300 FORMAT ("|tdN No. (FEET) (METERS) (DEGREES) (M SEC) (DEGREE CENTIG 
l|*,dNRADE) (MILLIBARS)") 

93 10 FORMAT (I2.I7.2X.15,7X.I3.4X.,F4.1.4X.F4-1.2X.F5.2.2X.F4.1. 

12X.F7.2 ) 

9850 FORMAT (12) 

9860 FORMAT ( 2 6X . 1 4 > 6 X i 1 2 . 1 X > 2 A 2 . I 4 ) 

9865 FORMAT ( I 4 . 3 X ; 1 2 , 1 X , 2 A 2 / 1 4 ) 

9870 FORMAT < I 6 , 1 X , 2F 4 . 1 . F 6 . 1 , F 6 . 1 , F 7 . 2 , 1 1 X , F 7 . 2 ) 

9875 FORMAT ( I 6 / 1 X , 2F 4 . 1 . F 6 . 1 , F 6 . 1 . F 7 . 2 ) 

REWIND 8 
9999 END 

SUBROUTINE I OH ED ( LH EA D , I T I M ES ) 

DIMENSION LHEAD(40,80) 

DO 110 I* 1. I TIMES 

READ ( 8 / 9855 ) ( L H E A D( I / J ) / J = 1 / 4 0 ) 

WRITE ( 6/ 9855 ) ( L HE AD ( I / J ) / J = 1 / 4 0 ) 

110 CONTINUE 
9855 FORMAT (40A2) 

RETURN 

END 

END* 
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Program SKEW T (Version II) 
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r> o o o n 


FTH4 


PROGRAM SKEy ^ 

DINEHSlOH I ALT<31 ,3 >< 1D1R( 31/3)> SPEED<31< 3 >/'TEHP(31 .3),PRESS( 31. 3> 
D1 HENS I OH SURDEN(6>.V(31 >. I SHR( 20 > . DPTEHP( 31 ^ 3 > . PTEHP( 31 . 3 > 
DIMENSION Q( 30 >/ A(23).C(23 >.B(23>/E( 1S).F(4. 4). G( 4. 4 >. K( 23> 
DIMENSION U(31<S>,X<40.5>. LHEADc 40 >. ALT< 3 1 1 3 >. IDCB< 254 > 

DIMENSION 1BUF(80>. NAMEC3> 

DATA HAHE/2HTE.2HNP.2HRD/ 

IFMT s 0 DATA IS VAR PT FORMAT 
IFMT > 1 DATA IS FIX PT FORMAT 
IREAD »0 DATA IS OH DISC 
IREAD >1 DATA IS ON TAPE 
** CONVERT RH AND TEMP TO DEHPT *« 

SFY = 10. /9 . 

C * 8.42926604 
D * 1 . 82717843 
E = 0.071208271 
C »* INITIALIZE DATA FORMATS AND INPUT UNITS «« 

IFMT = 0 
IREAD =: 0 
URITEC 1 . 1 1 ) 

11 FORMATC *|E6d6 ENTER CASE NUMBER *) 

READ< 1.20) N 
URITEC 1.10) 

10 FORMAT< "IlldB ENTER NUMBER OF POINTS ” > 

READ(1.20) NN 
20 F0RHAT<I2) 

HRITE( 1,15) 

15 FORHATC *|fl.dB ENTER ISTIM ISDAY ISHON ISM ISYEAR ■) 

RE AD (1.16) ISTIM. ISDAY. ISM OH. ISM. ISYEAR 

16 FORHAT< 14. 12. 2A2. 14 ) 

C ** INITIALIZE DATES ** 

LTIH = 1500 
LDAY = 29 
LHOH s 2H0C 
LM = 2HT 
LYEAR = 1975 

IF(IREAD.EQ.O) CALL OPEN( I DCS . I ERR . NAME . 0 > 

C CALL DATE 

P9=3 .14159 
M = 0 

IS«R< 1 )*0 
ISUR(2 ) = 0 
I SWR< 3 ) = 0 
ISWR<4 ) = 0 
ISWRCS )»0 
1 SUR< 6 ) = 0 
1SWR(7 ) = 0 
1 SUR( 8 )=0 
1SWRC9 )=0 
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isyR< 1 0 >=0 





ISUR(11)=0 





. I SWR< 12 )=0 





ISHR< 15 )=1 




61 

I0HIT«i5 

' 




IF <ISWR<1) . 

EQ. 

0) ' lUHlT-l 


88 

A< 1 ) = 0 





IF < ISUR< 8) . 

EQ. 

1) GO TO 140^' ^ 



IF< IFHT .EQ. 1 ) 

UR1TE<6, 9010) > ; ■ 


C 

' DEFINITION OF 

TERMS! 1 i V 



C TEMP< I ALT, N )--TEMPERATORE; PRESSt I'ALT’, M PRES SURE; OP TEHP< 1 A L T , H > - -HUH I D1 
C ='t. 

C ** LOAD DATA FROM TAPE ' < • 

1F< IREAD. EQ . 0) GO TO 121 • 

I T 1HES=5 

CALL I OHED( LHEAD , IT IMES ) 

C READ < S , ■;< > H 

READ <8,9860) L T 1 H , LD A Y LH 6 N, LM , L V E A R 
ITIMES=19 

CALL IOHED< LHEAD, IT IHES) 

C 

WRITE < 6, 9015) I ’ ' " ; - • 

READ < 1 , 9850 ) IFHO 
CALL PTAPE <8, IFNO, 0) 

C ^ , 

T2=9999 , , 

ITIMES=3 

CALL lOHEDCLHEAD, ITIHES) 

8000 READ <U,9865 ) I'ST IH , I SDAY, I SWOH , ISH, I SYEAR 
I F< I SDAY . EQ . 0 ) GO TO '8'OOO ■ 

WR ITE< 1 2 ) - 1 , 1 , 1 000 , 9750 

URITE<12, 8040)175, 0,0, 200, 1STIM,ISDAY,ISN0N, ISM, ISYEAR 
8040 FORMA T< 415, 20HRAUIHS0NDE SOUNDING: ,I5,1HZ,2X,I2,1X,.2A2,14) 

ITIMES=2 

CALL IOHED(LHEAD, ITIMES) 

READ < 8,9870 ) I A L T< 1 , N ) , ID I R< 1 , N ) , SP E ED < 1 , N ) , TE HP < 1 , N ) , 

1DPTEMP< 1 , N ) , PR£SS< 1 ,N ) , SURDEN< H ) 

001201=2,30 

115 READ < 8,9875 ) I A L T< I , H ) , ID I R< I , H ) , SP E ED < I , H ) , T E HP < I , H ) , 

10PTEMP< I , N ) , PRESS< I ,H ) 

CALL EXEC< 13,8, lEQT ) 

IEQT = IAND< IEQT, 200B ) 

IF < lEQT .GT . 0) GO TO 140 
IF <IALT<I,N) .LT. 10) GO TO 115 
IF <IALT<I,N) -GT. 10000) GO TO 115 
JARAY=I 

120 CONTINUE 

I F< IREAD . EQ . 1 ) GO TO 140 
C **LOAD DATA FROM DISC *♦* 

C 


A- 191 



121 CALL READF( IDCB, lERR. leUF) 

CALL CODE 
READ(IBUF.301 > 

T2 = 9999 

CALL REAOF< lOCBi lERR. IBUF) 

CALL CODE 

READ(IBUF;302) SURDEH(N) 

«R 1TE< 1 2 ) - 1 , 1 , 1 000 i 9750 

WRITE<12.8040) 175.0.0.200.ISTIM.ISDAY.ISM0H.ISN/ISYEAR 
DO 122 I =1.NH 

123 CALL READF< I DCB. I ERR/ I BUF ) 

CALL CODE 

READ<IBUF/303) IALT(I/N)/IDIR(I/N)/SPEED(I/H>/TEMP(I/M)/ 

IPRESSC I ,N )/ DPTEMPC 1 ) 

IF( lALTC I /H ) .LT . 1 ) GO TO 123 
] F( I ALT< I / N > . GT . 1 0000 ) GO TO 123 
T = 1000. /( TE»P< I ,N ) + 273.15 ) 

El = < DPTE«P< I / N )/l 00 . )* 10 . **< C - 0*T - E*T*T) 

Cl = ALOGT(El) - C 

DT = (SQRT(D*D - 4*E’fCl) - D)/(2*E) 

DT = < 1000 . /DT ) - 273.15 
DPTEHP< 1/ N) = DT 
JARAY = I 

122 CONTINUE 
C 

140 IF (lUNIT .EQ. 2 .OR. lUNIT . EQ . 3) U R I T E ( 6 / 4 0 2 0 ) 

4020 FORMAT < “NEED JUMP" ) 

C !N DATA SET HUMBER; L MO H , L DA Y , L YE A R / LT 1 M LAUNCH DATE/TIME 

C ! 

C ! ISTIM--SOUNDING TIME; T 2 - - PR E D I C T I OH TIME 
C CONVERTING SOUNDING TIME FROM ZULU TO EOT - AM , PM 
ISTIM=ISTIM-400 

IF< IFMT . EQ. 0 ) ISTIM = ISTIM-200 
IF < ISTIM . GT . 0 ) GO TO 250 
I STI M = 2400-ABS< I STI M ) 

ISDAY=ISDAY-1 

250 IF (ISTIM .GE. 1300) GO TO 260 

IF (ISTIM .GE. 1200 .AND. ISTIM .LT.1300) GO TO 270 
GO TO 280 

260 ISTIM=ISTIM-1200 
270 CONTINUE 
280 CONTINUE 

C : SURDEN( H )=SURFACE DENSITY 
C 

C CONVERT DATA TO METRIC/ SORT DATA BY lALT/ CAL POT T EM P =P TE M P( I A L T / N ) 
DO 590 I=1/JARAY 

C ! ENGL I SH TO METR IC 

ALT( I / N )= IALT( I / H ) 

IF( IFMT .EQ. 0 ) GO TO 509 
ALT( 1/ N )= ,3048*ALT( 1/ N > 
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SPEED( 1 >» . 515*SPEED< 1/ H> 

C ! SORT . . . . 

50^ L*I 


510 IF (L .EQ. 1 ) GO TO 590 

IF < ABS< ALT< L. H) ) . GT . ALT<L-1,H)) GO TO 590 
ALT(3I,H) = ALT<L-I.M> 

IDIR<31 .H >sIDIR< L-i iH > 

SPEED< 31/ H) = SPEED<L-1 / H) 

TEMP<31 /H >*TEMP( L-1 /H ) 

PRESS< 31/ N)=PRESS<L-1 /N) 

DPTEMP< 31 /H )»DPTEHP<L-1 / H) 

ALT< L-1 .H )»ALT<L, H) 

IDIR<L-1,N>»IDIR<L/H> 

SPEED< L-1 /H )=SPEED( L/ N ) 

TE«P(L-1/ H>*TEMP< L/ M) 

PRES S< L-1 /H )=PRESS( L/ N ) 
DPTE«P<L-l/N)=DPTEHP(LiH) 

ALT( L/ N > = ALT<31, H ) 

IDIRCL. H)»IDIR<31 .N > 

SPEED< L/H >*SPEEO< 31 /N > 

TE«P<L/ N)-TEHP(31 ,N ) 

PRESS< L> H )=PRESS< 31 /N > 

DPTEMP< L/ N)=DPTEHP< 31 / N) 

L = L-1 

570 GOTO 510 


590 COHTIHUE 

C ....... .CALCULATE POTENTIAL TEHPERATURE (DEG K) PTEHP(ALT,H> 

DO 690 I=1/JARAY 
C ALT( I / H ) = ABS< ALT< I> H ) ) 

PTEMP<I,N>=(TEMP(I,N) + 27 3.15)i.((1000/'PRESS<I,H>)**.2 88 > 

690 CONTINUE 

C PRINT METEOROLOGICAL DATA 

725 J=J9 

C IF <lSyR(12I .EQ. 0> WRITE <6«*) *CTR PRINT" 

C IF (ISUR(12> .EQ. 0) WAIT (15000) 


IF( IFMT EQ.O ) GO TO 727 
WRITE (6/9220) 

WRITE ( 6, 9140) 

WRITE (6/9140) 

WRITE (6/9140) 

IF (ISWR(15) .EQ. 0) WRITE (6/9230) 

IF (1SWR(15) .EQ. 1) WRITE (6/9240) 

727 IF( IFMT .EQ . 0 ) WR I TE ( 6 / 93 33 ) 

IF( IFMT .EQ.O ) WRITE(6/9334 ) 

IF( IFMT .EQ. 0 ) WRITE(6/ 9335 ) LTI M / LDAY / LMON / LM/ LYEAR 
IF( IFMT .EQ.O) GO TO 728 

WRITE (6/9250) LTIM/ LDAY/ LMON/ LM/ LYEAR 
WRITE (6/ 9140) 

728 WRITE (6/9260) ISTIM/ ISDAY/ ISMON/ ISM/ ISYEAR 
WRITE (6/9270) T2 
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E( . 66355 

WRITE <6. 9280) H, SURDEH(H) 

WRITE < 6. 9140) 

WRITE < 6. 9290) 

WRITE (6.9300) 

DO 850 I-1,J8RAY 

SPEED! I .H )=INT(SPEEO< I .N )*i0)/10 
IALTF = ftLT< I , M)/. 3048+ . 5 
IRLT<I.N)=ftl.T< I.N)+ .5 
APTEI1P = PTEHP< I .H )-273 . 15 

WRITE (6,9310) I, lALTF, lALTd.N), IDIR(I,N), SPEEDd.N), TEHP(I, 
IN ), APTEMP, DPTEHPCI ,N ) ,PRESS( I, H ) 

850 CONTINUE 
C 

C PLOT SKEW T , LOG P DIAGRAM 

C *♦ COMPUTE lY USING V1,V2,V3 FOR LOGRITHMIC PLOT CONVERSIONS ** 

VI = 58470.457 
V2 = -28656.688 
V3 = 3078.846 

C SET AT(-1 F, 1050MB) I. (“"82.5 F, 500MB) 

C 

IPEN=-l 
DO 900 1=1, NH 

1F(PRESS( I,N).LT.545) GO TO 900 

IX = 142 . 8*(TEMPd , N) + 273. 15 )-1083 1 . *ALOGT( PRESS! I, N) )-3668 . 

IY= V1*AL0GT(PRESS( I,H>) + V2*( A LO GT ( PR ES S ( I , N ) ) ) ** 2 + 

1V3*( ALOGT(PRESS( I ,N ) ) )**3 
lY = IY*SFY 

WRITE! 12) IPEN,1, IX, lY 
IPEN=1 

900 CONTINUE 

WRITE! 12) -1 i-.I, 100,-150 
WRITE ! 12,9031 ) 100,0,0, 125 

9031 FORMAT! 415, 7HAMBIENT) 

C PAUSE 

IPEH=-1 
DO 925 1=1, NH 

IF!PR£SS! I, N ). LT . 545) GO TO 925 

IX = 142.8*!DPTEMP! I,N) + 273. 15)-10831.*ALOGT(PRESS( I,N))-3668. 
IY=V1*AL0GT! PRESS!! ,N ) ) + V2»! ALOGT! PRESS! I , N ) ) )**2 + 

1V3*( AL0GT!PRESS( I , N )) >**3 
lY = IY*SFY 

WRITE! 12) 1PEN,1 , IX,1Y 
IPEH=1 

925 CONTINUE 

WRITE! 12) -1,-1,100,-150 
WRITE (12,9032) 100,0,0,125 

9032 FORMAT! 415, 9HDEW POINT) 

950 WRITE(12) -1,1,9999,9999 

DELP=850 
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DO 975 I=liHN 

IF<PRESS< 1/ H ). LT . 545) GO TO 975 
1F( PRESS< I. H ) . NE . DELP ) GO TO 975 
0ELP=DELP-50 
IZ = 3 .28084*IALT( I ,N > 

I Y = Vl*ALOGT< PRESS< I ,H ) > + V2K ALOGT< PRESS( I . H ) ) )**2 + 

1V3*< ALOGT<PRESS( I .H > ) >=»*3 
lY = IY*SFY 
yRITE< 12)-1 , 1. 200, I Y 
WRITE< 12, 9030) 75,0,0,100,12 
9030 F0RWftT<4I5,I5,3H FT) 

WRITE< 12)-1 , 1,850.1Y 
WRITE< 12) 1 , 1,900, I Y 
URITE< 1 2 )-l , 1 , 875 , I Y 

WRITE(12,9020) 75,0,0,100,IALT<I,H) 

9020 F0RMAT<4I5, 15, 7H METERS) 

303 F0RMAT(5X,I4,7X,I3,7X,F5.1,4X,F5.1,6X,F5.1,5X,F5.1,19X) 

301 F0RHAT<80X) 

302 FORHAT( 59X, Ft. 1, 15X ) 

975 CONTINUE 

WRITE! 12) -1 , 1, 250,9500 

WR ITE< 1 2, 902 1 ) 100, 0,0,125 
902 1 FORMAT! 415, 8HALTITUDE ) 

UR ITE! 12 ) - 1 , 1,9999,9999 
9010 FORMAT (IX, "DATA NUMBER* " , " 4" , " 0 " > 

9015 FORMAT ( 1 X , " dB E NT ER FILE NUMBER IN 2 DIGIT I FORM AT»|t.d0" ) 

9140 FORMAT (70X) 

9190 FORMAT <1X, "========================================== ==========") 

9220 FORMAT (IX, “+++++++++++++++++++++++++++++++++++++++++++++++♦++++“) 
9230 FORMAT !7X, "SPACE SHUTTLE LAUNCH FROM KSC") 

9240 FORMAT (IX, “TITAN IIIC LAUNCH FROM KSC") 

9250 FORMAT ( 1 X , " |tdC L au nc h t i n e ! " , I 8 , 9 X , " D a te : " , 1 2 , 1 X , 2 A 2 , 1 X , 1 4 ) 

9260 FORMAT (IX, “ TIME OF SOUNDING: “ , I 8 , 4X , I 2 , 1 X , 2 A2 , 1 X , I 4 ) 

9270 FORMAT (IX," TIME OF PREDICTION: ",I4) 

9280 FORMAT (IX, "DATA SETs “ , 12 , 13X, " SURF ACE D E NS I T Y ( G M/ M **3 ) " , F 8 . 2 ) 

9290 FORMAT (5X, "LAYER A L T I TU DE " , 2 X , " D I RE C T I ON " , 1 X , " SP EE D “ , 3X , 

1" TEMP" , IX , "DP-TEMP" , IX , "PRESSURE* ) 

9300 F0RMAT(1X,“N0.“,2X,“FEET“,IX,"METERS",3X,"DEGREES“,3X,"M SEC", 

I4X, "DEGREE C EN T I G RA DE " , 1 X, " MI LL I B A RS " ) 

9333 FORMAT! IX, "*♦*****♦***’»*♦'•'**•***********•*’****♦**♦•*♦“ ) 

9334 FORMAT! IX, "SPACE SHUTTLE SRM DDTE PROGRAM TEST FIRINGS AT THIOKOL 
1 WASATCH") 

9335 F0RMAT(1X,“ LAUNCH TIME: " , 1 8 , 9 X , " D A T E : " , I 2 , 1 X , 2 A2 , 1 X , 1 4 ) 

9310 FORMAT (1X,I2,I7,2X,I5,7X,I3,4X,F4.1,4X,F4.1,2X,F5.2,2X,F4.1, 

12X,F7. 2 ) 

9850 FORMAT (12) 

9860 FORMAT ( 26X , 14 , 6X , I 2, 1 X, 2A2 , I 4 ) 

9865 FORMAT ( I 4 , 3 X , 1 2 , 1 X , 2 A 2 , 1 4 ) 

9870 FORMAT ( I 6, 1 X, 2F4 . 1 , F6 . 1 , F6 . 1 , F 7 . 2 , I 1 X, F7 . 2 ) 

^75 FORMAT ( I 6 , 1 X , 2F 4 . 1 , F 6 . 1 , F 6 . 1 , F 7 . 2 ) 
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IF( IFNT.EQ. 1 > REVIND 8 
IF( IFHT .EQ.O > CALL CLOSEUOCB) 
9999 END ■ 

SUBROUTINE I OHEiX LHEAO » I TI HES > 
DIHEHSIOH LHEAD<40> 

DO 110 I«1.ITIHES 
READ (8.98S5>(LHEAD(N),N*1.40) 
WRITE (6. 9886>(LHEAD(N),H«1»40> 
110 CONTINUE 
9859 FORMAT (40A2> 

9856 FORMAT ( 1X< 40A2) 

RETURN 

END 

END4 


A-196 


mil 


iiM I iiiniiiiiMmi 


Program PUFF 


A-197 



FTH4. L 


PROGRAM PUFF 

C MAIN 

DIMENSION ICARDS<40). IBUF(40). IDCB( 256 ). HAHE<3) 

REAL MOE.MEDOTjM(JINF.M£,MrHF,Ml.M2,Lr 

COMMON V<ll),DV(in,T,DT,NV/G<3).RAD,PI,R,UGC.MEDOT.TOFF/TC, 
lME,t1INF,VC.RHOE.CPE,RE,GAME.MUE.TE.PE,UEX.UEY.UEZ,UE, 
2HC,CD.RH0INF,CPIHF.RINF,GAMIHF.M«IHF.TINF,PINF,THETA, 
3GAMMAiPC.APPP.VELU(3),H.CR>LT,XC.ACS,ASP.IFLAG 

DATA OTO/D.Dl/. I P R . J . I OF F /3 *0 / 

DATA NAME/ZHiP.aHUF.ZHFD/ 

C DATA V.DV.T-DT,NV/'2 3*0.- .01-11/>G.RAD,PI/'2*0.,980,7,57.296,3.1416Z 

C DATA TE/1 000.7, T INF7288 . / . PE/1 . DX ^ P INF/ 1 . 0// GAMEX 1 . 2678X 

C DATA GAMIHFX1.4X, MUEX19.648X, M « I NF X 28 . 9 6 6 X , U GC X8 2 . 0 56 7 X . HCXO.OX 

C LOAD INITIAL DATA VALUES REPLACING DATA STATEMENTS 
TE = 1 000 . 

T INF=28S . 

PE = 1 . 0 
PIHF = 1 . 0 
GAME=1 . 2678 
GAMIHF = 1 . 4 
MUE= 19 . 648 
MU INF=28 . 966 
UGC=82 . 0567 
KC = 0 . 0 

DO 111 1=1.11 

VC I ) = 0.0 
DVC I ) = 0.0 
111 CONTINUE 
T = 0 . 0 
0T= . 01 
H V = 1 1 

G< 1 ) = 0.0 
G< 2 ) = 0.0 
G( 3) = 980.7 
RAD= 57.296 
PI = 3.1416 

C CALL ERRSETC 208. - 1 . -1 , 1 > 

C ESTABLISH PARAMETERS 

C FOLLOWING ARE DEFINITIONS OF INPUT DATA... 

C TOFF. ..TIME WHEN JET IS SHUT OFF(SEC) 

C TMAX...TIME WHEN SOLUTION IS STOPPEDCSEC) 

C DTI .... INTEGRATION STEP SIZECSEC) 

C I PR I NT .. NUMBER OF STEPS BETWEEN P R I N TO U T( I P R I N T= 1 . P R I N TS DATA EACH STEP) 
C IFLAG. .CONTROLS DEBUG PRINTOUT. IFLAG=1 WRITES FORMAT 100 IN SUBROUTINE 
C DERIV AND FORMATS 100-105 IN SUBROUTINE SHAPE 

C I UN I TS . CONTROLS UNITS OF OUTPUTCO = CM + G. 1=H + KG) 

C R JET EXIT RADIUSCCM) 

C UE JET EXIT VELOCITY CCMXSEC) 
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C GAMMA.. JET EXIT Ek E V A T I 0 N AH GLE ( D E G ) . HORIZONTAL IS ZERO. 

C TE.....^^JET EXIT TEMPERATURE< DEG-K ) 

C GAME. ..JET EXIT SPECIFIC HEAT RATIO 
C HUE.. ..JET EXIT MOLECULAR HEIGHT 
C TIHF .. .ATMOSPHERIC TEMPERATURE( DEG-K > 

C PIHF .. .ATMOSPHERIC PRESSURE< ATMOSPHERES > 

C GAMINF .ATMOSPHERIC SPECIFIC HEAT RATIO 

C MHINF. .ATMOSPHERIC MOLECULAR HEIGHT 

C APPPl . .ENTRAINMENT COEFFICIENT BEFORE TAIL EXCEEDS 15 DIAMETERS 

C APPP2. ENTRAINMENT COEFFICIENT AFTER TAIL EXCEEDS IS DIAMETERS 

C .CD1..DRAG COEFFICIENT BEFORE TAIL EXCEEDS IS DIAMETERS 
C CD2..DRAG COEFFICIENT AFTER TAIL EXCEEDS 15 DIAMETERS 

C THETA.. JET EXIT AZIMUTH UITH RESPECT TO X-COORDI NATE( DEG > 

C VELU...HIHO VECTOR COMPONENTS IN X YZ -C 0 OR D I H AT ES ( CM /S E C ) 

C OPEN INPUT DATA FILE kPUFFO 

CALL OPEN( lOCB < lERR >NAME<0 > 

C READ AND PRINT OUT INPUT TEST DATA 
HRITE<6,303 ) 

303 FORMAT< IHli • INPUT DATA IS AS FOLLOUS: “) 

DO 320 1=1,5 

CALL BLANK< IBUF) 

CALL READF< IDCB, lERR, IBUF) 

CALL CODE 

READ( IBUF, 301 ) ICARDS 

301 F0RMAT<40A?> 

HRITE< 6,302 > < IC ARDS( N >, N= 1 , 40 > 

302 FORMAT( IH , 40A2) 

320 CONTINUE 

C REHIND AND READ INPUT DATA TO PROCESS 
CALL RHNDF< IDCB, lERR) 

CALL BLANKS IBUF ) 

CALL READFC IDCB, lERR, IBUF) 

CALL CODE 

R^ AD (IBUF, 304) TOFF,TMAX,DTI,R,UE 

304 FORMATC 5< 7X , F8 .2 ) ) 

CALL_READF< IDCB, lERR, IBUF) 

CALL CODE 

RE AD (IBUF, 30 4) GAMMA, TE, GAME, MHE, TIHF 
CALL READF( IDCB, lERR, IBUF) 

CALL CODE 

READ( I6UF,30B) PI NF, GAMINF, MHINF, APPPl, APPP2 
CALL READF( IDCB, lERR, IBUF) 

CALL CODE 

READ( IBUF, 307) CDl, CD2, THETA, VELH(l), VELU( 2 ) 

CALL READF( IDCB, lERR, IBUF) 

CALL CODE 

READ( IBUF, 305) VELH(3), IPR IH T, I FL AG , I UNI T S 

305 F0RMAT(7X,F8.0,3(7X,I8)) 

306 F0RMAT( 5( 7X . F8 .5 ) ) 
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307 FORMATC 5< 7X, F8 .3 ) > 

VRITE<6>388) TOFF , TNAX > DTI . R/ UE 
URITE< 8/388 > GAKHA/ TE / GAME / HUE/ T INF 
URITE< 8/388 ) P INF . GAH I NF . HN INF/ APPPl / APPP2 
URITE(8/388> GDI/ CD 2/THE TA/VELU(1)/VELU<2> 

WRIT E< 6/389) VELU<3)/IPRIHT/IFLAG/IUNITS 

C388 F0RMAT<1H /"SAMPLE INPUT " / / / 5E20 . 8 ) 

C389 FORMATdH /E20. 6/3110) 

VELW< 2 ) = 0 . 

APPP = APPP 1 
CD=CDi 

C COMPUTE SOME OTHER INVARIANT PARAMETERS 
D15=30 . *R 
PE = P INF 
PC=PE 

RE-UGC/MWE 

RINF=UGC/MHINF 

CPE = RE*GAME/’< GAME-1 .0 ) 

CPIN F= RIH F* GAM INF /< GAMIN F- 1.0) 

RHOE=PE/RE/TE 

RHOINF=PINF/RINF/TINF 

TRAD = THETA/^RAD 

GRAD»GAMMA/RAD 

UEX = UE*COS< GRAD)*COS( TRAD) 

UEY»UEo>COS( GRAD )*SIN( TRAD) 

UEZaUE*SIN( GRAD) 

AE»PI*R **2 
HEDOT«=RHOE*AE*UE 

C ESTABLISH OUTPUT CONSTANTS 
Cl=l .0 
C2 = l . 0 
C3 = l .0_ 

IF < lUNITS.EQ. 0) GO TO 13 
C1=0 .01 
C2 = l .E-6 
C3 = 0 .001 
13 CONTINUE 

C URITE( 8/200 ) U GC / HE DO T / R HO E / A E / R HO I N F / R E / R I N F / C PE / C P I N F 

200 FORMATC "/9E12.5) 

WRITE ( 8/ 210 ) 

C INTEGRATE FOR TMAX SECONDS/ PRINT EVERY IPRINT STEPS. 

10 CONTINUE 
DT = 0 . 1 
J=J + 1 
IPR=IPR+1 

C ALWAYS USE DT*DTO DURING FIRST 0.1 SEC OF JET OH 
DT=DTI 

C IF ( T . GE. 0 . . AMD . T .LT. 0 . 099 ) DT = DTO 

IFC T .GE .0 . . AND . T . LT . 1 . ) DT = DTO 
CALL RK4 
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C IF TAIL LENGTH GT 15 DIAHETERS^ CHANGE ENTRAINHENT COEF 
IF (LT.LT.D15.0R. APPP.EQ.APPP2) G6 TO 11 
APPP=APPP2 
CD>CD2 

HRITE<e,120> 

120 FORHATC "OCLOUD TAIL EXCEEDS IS DIAMETERS. ENTRAINMENT COEF INCREA 
1SES-) 

URITE(S<210> 

11 CONTINUE 

IF < T. LT. TOFF. OR . lOFF . EO . 1 > GO TO 12 
URITE(6.130> TOFF 

130 FORMATCIH ,"JET SHUT OFF AT T = •‘,F6.2,» SEC") 

URITE( £>210) 

210 FORMAT( "0", 3X, "T" ,£X. "X" ,£X , “ Y“ , 6X , *2". 5X. "VX" , 5X. • VY“ .5X, “ V2" .5X/ 

1 "TC“ , 5X i "XT" ,5X , • YT" i 5X, "2T“, 5X. "LT", 5X. "LS" > 5X, “CR* , 

2 7X, ‘ME*. £X. "MINF". 6X. “VOL" ) 

I0FF=1 

12 CONTINUE 

IF < IPR .LT. IPRINT ) GO TO 10 
C WRITE INTEGRATION VARIABLES AND CLOUD DIMENSIONS 
IPR = 0 

C SET NODE TO 1 
M0DE=1 

CALL EVALKMODE) 

IF < IFLAG .EQ .0 ) GO TO 9 
URITE(£,210> 

9 CONTINUE 

C CONVERT TO METERS, KG IF REQUIRED 
X=V( 6 )♦ Cl 
Y = V( 7 )*C1 
2 = V< 8 )*CI 
VX=DV< £ )*C1 
VY=DV< 7 )*C1 
VZ*DV( 8 )*C1 
ELT=LT*C1 
XT = V< 9 )*C1 
YT = V< 10 >*C1 
ZT=V< 1 1 )*C1 
ELS*<LT + H-CR )*C1 
RCLD*CR*C 1 
N1=NE*C3 
M2=MINF*C3 
V0L*VC*C2 

WRIT E( £,220) T,X,Y,Z,VX,VY,VZ,TC,XT,YT,ZT,ELT,ELS,RCLD,N1,M2,V0L 
220 FORNAT(“ “ , F 5 . 2 , £F7 . 2 , F7 . 0 , £F 7 . 2 , 3 F9 . 1 ) 

IF (T.LT.TNAX) GO TO 10 
CALL CLOSE< IDCB, lERR) 

STOP 

END 
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SUBROUTINE BLANfC< IBUF) 

DIMENSION IBUF<40) 

DATA IBLK/2H / 

DO 66 N=l<40 
66 IBUF(N> = IBLK 
RETURN 
END 

SUBROUTINE DERIV 

REAL M«Eil1EDOT,MWINF,LT 

COMMON V< 1 1 ) . D V( 1 1 ) . T , DT , HV , G< 3 ) , R AD , PI . R . UGC. MEDOT , TOFF , TC 1 
lME,MINF,VC.RHOE.CPE.RE,GAME,MUE,TE,PEiUEX.UEY.UEZ,UE, 

2HC, CD/ R HO I N F.CPINF.RINF. GAM INF, MWINF.TINF. PI NF. THETA, 
3GAMMA,PC/APPP,VELU<3),H,CR/LT,XC/ACS,ASP,IFLAG 
REAL MA,MC,ME,MlX,Miy/MI2,M2X,M2y,M2Z/M3X/t13Y,M3Z/MINF,M0MX, 
1 HOMY, MOMZ, MDT INF 

EQUIVALENCE <V(1)/MC),<V<2)/MOMX)/<V<3),MOMY),(V<4),MOMZ), 

1 <V<5)/EC),<V<6)/CGX)/(V<7),CGY),<V(8>,CGZ)/<V(9),STX), 

2 ( V< 10 >, STY ), < VC U ) / STZ ) 

DIMENSION UINFC3) 

DATA DXL, DYL / VCL , SCGL/4*0 . / 

H0DE=0 

IF ( T . NE . 0 . 0 ) GO TO 10 
C COMPUTE INITIAL DERIVATIVES 

DVC 1 ) = MEDOT 
DVC2 )=MEDOT*UEX 
DVC3 )=MEOOT*UEY 
DVC4 ) = MEDOT>i>UEZ 
DVC5 )=MEDOT*CPE*TE 
DVC 6 ) = UE»'0 . 5 
DVC 7 ) = 0 . 

DVC 8 >=0 . 

DVC 9 > = 0 . 

DVC 10)=0. 

DVC 1 1 )=0 . 

ME=0 . 

RETURN 

10 CALL EVALICMODE) 

RETURN 

END 

SUBROUTINE EVALICMODE) 

COMMON VC11)/DVC11),T,DT/NV/GC3)/RAD,PI/R,UGC,MED0T/T0FF,TC, 
lME/MINF/VC,RHOE,CPE,RE,GAME/MUE,TE,PE,UEX,UEy,UEZ,UE/ 

2H C/CD, R HO INF/CPINF/RINF,GAMINF/MMINF,TINF,PINF, THETA, 
3GAMMA,PC,APPP,VEL«C3)/H,CR,LT/XC/ACS,ASP,IFLAG 
REAL MWE, MEDOT/MWINF, LT 

REAL MA/MC/ME/M1X/M1Y,M12/M2X,M2Y,M2Z,M3X/M3Y,M3Z/MINF/M0MX, 
IMOMY/MOMZ/MDTINF 

EQUIVALENCE CVC1),MC),CVC2)/M0MX>/CVC3),H0MY)/CVC4)/M0MZ), 

1 CVC5)/EC),CVC6)/CGX),CVC7),CGY)/CVC8>/CGZ>,CVC9)/STX), 

1 C VC 10 ) /STY ) , C VC 1 1 ) / STZ ) 
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DIMENSION UINFC3) 

DATA DXL,DYL,VCL,SCGL/4*0./' 

C THIS ENTRY USED TO FIND CLOUD SHAPE. HOT USED UHEH INTEGRATING. 
C MODE=l 

10 CONTINUE 

C AT TOFF SET MED0T=0 + HOLD ME CONSTANT 
IF < T . GE . TOFF > GO TO 12 
ME=MEDOT*T 
GO TO 14 
12 CONTINUE 

IF ( MEDOT .EQ . 0 ) GO TO 14 

HE=HEDOT*TOFF 

MED0T = 0 . 

14 CONTINUE 

M1NF=MC-ME 

CPC=<MINF*CPIMF+ME*CPE)/MC 
TC=EC/( MC*CPC ) 

RC=<MINF*RINF+ME*RE>/MC 
RHOC=PC/< RC*TC ) 

VC=MC/RHOC 
DX=CGX-STX 
0 Y=CGY-STY 
DZ=CGZ-STZ 

SCG=SQRT(DX*DX+DY*DY+DZ*DZ) 

C CALL CLOUD SHAPE SUBROUTINE TO GET ACS 
VZ = VC 

CALL SHAPE< VZ, SCG ) 

C IF M0DE=1.. EVALUATE CLOUD SHAPE BUT NO DERRIVATIVES REfiUIREO. 

IF < MODE . EQ . 1 ) GO TO 20 
MA=0 ,5*RH0INF*VC 
CALL WIND (CGZ.UINF) 

UCX = <M0MX+MA*UINF<l))/(t1C + MA) 

UCY=<M0MY+MA*UINF<2))/<MC+MA) 

UCZ=(M0MZ+MA*UINF<3))/<MC+MA) 

UC = SQRT<:UCX + =t'2 + UCY’»=f2 + UCZt=*2) 

ELS = < LT+H-CR >/SCG 

CSX=STX+DX*ELS 

CSY=ST Y+DY*ELS 

CSZ=STZ+DZ*ELS 

ELT=LT/SCG 

SLX*STX+DX*ELT 

SLY=STY+DY*ELT 

SLZ=STZ+DZ*ELT 

SL = SQRT<;SLX*SLX+SLY*SLY + SLZi‘SLZ) 
ST=SQRT<STX**2+STY**2 +STZk*2) 

URX*UI NFC 1 )-UCX 
URY=UINF(2)-UCY 
URZ = UINF< 3)-UCZ 
UR = SQRT<URX**2 + URY*>c2 + URZ**2) 

MDTINF=RHOINF*UR*ACS*APPP 
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«1X=HE00T*UEX 

W1Y=HED0T*UEY 

H1Z=HED0T*UEZ 

C0NST=2 . 0*HA-HC 

H2X=G< 1 )<i<CONST 

H2Y = G< 2 )*CONST 

«2Z = G< 3 )*COHST 

CONST=UR*ASP*CD*RHOINF 

H3X=URX«C0NST 

«3Y=UR Y*CONST 

«3Z=URZ*C0HST 

E1=HED0T*CPE*TE 

E2=«DTINF*CPINF*TIHF 

SBC0N=1 -355E-12*4l . 293 

EMISS=0 .4 

E3=ENISS*SBC0N*ACS*< TINF**4-TC**4 ) 

E4=2 . 0*PINF*MED0T/RH0 INF 

DV< 1 ) = NEDOT + MDTINF 

DV(2 ) = H1X + H2X+M3X 

DV<3 ) = M1Y + H2Y+M3Y 

DVC4 ) = «1Z + H2Z+M3Z 

0V< 5 )=E1+E2+E3 

BV< 6 ) = UCX 

0V<7 )*UCY 

DV<8> = UCZ 

IF (T.LT.TOFF) GO TO 30 

DVC9 > = UEX*DX*LT/( STX*SCG + DX*LT+i .OE-9 >+UCX 
DV( 10)=UEY*DY*LT/<STY*SCG+0Y*LT+1 . 0E-9)+UCY 
DV< 1 1 ) = UEZ*DZ*LT/< S TZ*SCG+DZ*LT + 1 . OE-9 ) + UCZ 
30 CONTINUE 

IF < IFLAG .EQ .0 ) GO TO 9 
F0ELTA = N3X-MA*DV < i ) 

VB=VC/RE**3 

XB=XCG/RE 

C WRITE DEBUG OUTPUT 

WR ITE< 6 . 1 00 ) HE. HINF/ CPC i TC . RC. RHOC. VC. HA/ UCX< UCY.UCZ^ UCi SCG/ URX. 
lURY.URZiUR,niX.t11Y.niZ.N2X.N2Y.N2Z.H3X.H3Y.H3Z.El.E2.E3.E4 
2 , NDTINF. CR. XC. ASP . H . LT . XB . VB. FDELTA , ACS . T, ST 

9 CONTINUE 

10 0 FORNATC IHO. "«E.HINF.CPC.TC.RC.RH0C = *.6E15.5/. 

1 " VCiHA,UCX.UCY.UCZiUC=*.6El5.5/, 

2 " SCG. URX . URY. URZ. UR-. N1X = " ,6E15 . 57 , 

3 “ HIY. MIZ. M2X ,M2Y. M2Z, N3X . =“ .6E15 . 5/ , 

4 “ N3Y. N3Z. El I E2. E3. E4. =“ . 6E15 . 57 1 

5 " HDTINF.CR.XC, AS P , H , LT = “ , 6 E 1 5 . 5 7 . 
i " XB.VB.FDELTA.ACS.T.ST =“.6E15.5) 

20 CONTINUE 
RETURN 
END 

SUBROUTINE UIHD(H.UINF> 
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DIHENSIOH UINF(3 > 

COMHON DUH6(24>/ IDUN6 . DUH7( 37 VELVCS 0UN8( 6 ) , 10UN8 
DO 100 1*1^ 3 
UINFC I > * VELUC I > 

100 CONTINUE 
RETURN 
END 

SUBROUTINE SHAPE(VZ/CG> 

DINENSION XC0F(4>.C0F<4).R00TR<3>/R00TI<3> 

DOUBLE PRECISION 0/ 08 / 8/ B^ Y 1 / PB Y3CU/ ROOTS < XBAR « PBAR / RES 
REAL LT 

COMMON DUNK 24 >/ I DUN9 , C( 3 > < RAD/ P I / R/ DUN2( 9 >/ 

1DUM3(25 >/H/CR/LT/XC/ACS/ASP»IFLAG 
DATA RELAST/O./zN/O/ 

C COMPUTE CONSTANTS ONLY ONCE UNLESS RE CHANGES VALUE 
IF <R.EQ. RELAST) GO TO 2 
RELAST«R 
REZ-’RvR 
RE4«RE2*RE2 
RE6«RE4*RE2 
DE>2 .0«R 

VRITE(6.341> RELAST/R / RE2 / RE4, RES < OE 

341 FORMATCIH /'RELAST/R / RE2/ RE4 / RES / DE " / / / 1 H /SE20.S) 
SE»PIoRE2 

SEIHV«1 .0/SE 
CONl^O . 5/<SE*DE> 

PBY3CU»<-RE4 >**3 

HR1TE<S.342> SE/ P I / SE I NV < CONI / PBY3CU / XCOF< 1) 

342 FORMATCIH / " SE / P I . SEI N V / CON 1 / PB Y 3CU/ XCOFC 1 >' / / / IN /6E20.6) 
XC0FC2 >*SE/24.0 

XC0FC3 )*0 . 

XCOFC 4 )=-PI*PI/< 72. 0*SE) 

URITEC 6/3 43 ) XC0F(2)/XC0F(3)/XC0F(4) 

343 FORMATCIH / ■■ XCOF C 2 ) / XCOFC 3 > / XCOFC 4 ) ' / / . 1 H /6E20.S) 

2 CONTINUE 

XBAR-CC/DE 

PBAR«VZ*C0N1 

0«-S76 . *PBAR*C P6AR-XBAR)'*RE6 
QQ«PBY3CU+C 0*0 .5 )**2 

UR I TEC 6/940 ) 0 / 00 . PBY3CU / PBAR / XBAR < RES 
940 FORMATCIH /■ 0 / 00 / PBY3CU/ PBAR / XBAR / RES ‘ /// 1 H /SE20.6) 

IF C 00 . LT .0 . ) CO TO 20 
ROOTQ«DSORTC 00 ) 

A«CDA6SC-0*0 .Si- ROOTS ) )**0 . 33333333 
B«CDABSC-0*0 .3- ROOTS ) )**0 . 33333333 
Y1«A+B 
H«DSORTC Y1 ) 

IF C IFLAC .EO .0 ) GO TO 30 

Y2»-CA + B)*0 . 5 

Y3=C A-B >*0.5*1 .73205 
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BRITE<6,105) Yl,V2,Y3 
105 FORMATC * , 20X , • Y I , Y2 , Y3 = " . 3< IPE 12 . 4 ) ) 

GO TO 30 
20 CONTINUE 

XCOF< 1 )=VZ*(VZ*0 .5*SEINV-CG) 

K>3 

URITE< 6.9302 > XCOF( 1 > 

9302 FORHAT< 1X."XC0F1= '.£12. 5) 

CALL POLRTtXCOF.COF.N.ROOTR.ROOTI. lER ) 

C FIND SMALLEST POSITIVE REAL ROOT 
RHIN=1E10 
DO 10 1=1. H 

1F<ROOTHI>.EQ.O.O.AMD.ROOTR(I).LT.RNIN.AND.ROOTR(I).GT.O.> RNIH = 
1 ROOTRd) 

10 CONTINUE 

IF < IFLAG .EQ .0 ) GO TO 6 
DX = 1 ,0/<288 . *PBAR ) 

XHAX = PBAR-<-DX 
XHIN=PBAR-DX 
C TEST NATURE OF ROOTS 

IF (XBAR^LT.XHAX. AHD.XBAR.GT.XNIH. AHD.XBAR.GT.PBAR) UR I TEC 6. 101) 
IF CXBAR.LT.XMAX.AND.XBAR.GT.XNIN.AHD.XBAR.LT.PBAR) URITEC6.102) 
IFCCXBAR.GT.XHAX.OR . XBAR . LT . XH I H > . AND . XBAR . GT . PB AR > URITEC6. 103) 
IFCC XBAR. GT . XMAX . OR . XBAR . LT . XN I N ) . AND . XB AR . LT . PBAR ) URITEC 6. 104 > 

101 FORHATC 3 REAL ROOTS, 2 POSITIVE, 1 HE G A T I V E* , 58 X , “ RE AL “ , 6 X , 

1 ■ IHAJ " ) 

102 FORNATC 3 REAL ROOTS, 1 POSITIVE, 2 NEGAT I VE* , 58X, " REAL “ , 6X, 

1 "IMAJ") 

103 FORHATC* 1 REAL ROOT, NEGATIVE ” , 5 8X , “ RE AL “ , 6X , 

1 •‘INAd") 

104 FORNATC* I REAL ROOT, POSITIVE , 5 8X , ■ R E A L " , 6X , 

1 "INAJ") 

URITEC 6 , 100 >XBAR , XHAX, XHIH , PBAR, lER, C CROOTRC I > , ROOT IC I > >, 1=1, H > 
100 FORNATCIH , ■■ B AR , XH AX , XN I N , PB AR , I E R , ROO TS = * , 4C 1 PE 1 2 . 4 ) , I 3 , 8 X , 

1 2E12 . 4.5C/90X , 2E12 . 4 ) ) 

6 CONTINUE 

C IF NO POSITIVE ROOTS, WRITE ERROR MESSAGE 
IF C RH IN. E8 . lEiO > GO TO 40 
H = SQRTC RHIN > 

30 CONTINUE 

CR=0.5*CH+R *R /H) 

LT = VZ*SEIHV-0 . 5*H-PI*H**3/C 6 . *SE ) 

XC=H+LT-CR 
ASP=PI*CR**2 
ACS=2.*PI*CR ♦LT+CR+H) 

C DO HOT INCLUDE LT IN SURFACE AREA IF IT IS NEGATIVE 
IF CLT.LT.O.) ACS=2.*PI*CR*H 
C CORRECT PROJECTED AREA IF NOT SPHERICAL 
IF CXC.LT.LT) ASP=SE 
RETURN 
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40 CONTINUE 

10.6 FORHAT( “OPROGRAH HALT. POSITIVE ROOT FOR H NOT FOUND.”) 

HRITE(6>100)X8AR.XHAX>XMIH,PBAR> IER<<<ROOTR( I > , ROOT I( I > ) > !« 1 , 3 ) 
HRITE(£/i06> 

STOP 

END 

SUBROUTINE RK4 
DIMENSION OLD< 11 ),B(11 ) 

C THIS IS A 4TH ORDER RUNGE-KUTTA INTEGRATOR 

COMMON V(11).DV(11>/T.DT/HV>DUCK(46)/1DUCK 
DATA J/0/ 

OLDT=T 
D02J=1 , HV 
2 OLD( J >»V( J > 

CALL DERIV 
T-OLDT+0. 5*DT 
D04J=1 i NV 
B< J )=OT#DV< J ) 

4 V( J ) = OLD< J ) + 0 . 5*B< J ) 

CALL DERIV 
D06J=1 . NV 
TMP = DT*DV< J > 

B<J)=8<J)+2*TMP 
6 V( J)=0LDC J)+0.5*TMP 
CALL DERIV 
D08J=1 ^ NV 
TMP = DT*DV< J ) 

8< J )=B< J ) + 2*TMP 
8 VC J )=OLD< J ) + TMP 
T=OLDT+DT 
CALL DERIV 
DO 10 J=1 <NV 

10 VC J ) = OLD< J ) + CBC J ) + DT*DVC J ) )/6 
RETURN 
END 

SUBROUTINE POLRTC XCOF , COF/ M . ROOTR. ROOTI . I ER > 

DIMENSION XCOFC 1 )/COFC 1 ).ROOTRC 1 >. ROOTIC 1 > 

DOUBLE PRECISION XO . VO . X . V < XP R , Y PR . U X . U Y . V , Y T , X T . U . XT2 i 
lYT2i SUMSQ,DX,DY. TEH Pi ALPHA 
IFIT-0 
N = M 
IER»0 

IFC XCOFCH + 1 > )10, 25i 10 
10 IFCH > 15i I5i 32 
C SET ERROR CODE TO 1 
15 lERsl 
20 RETURN 

C SET ERROR CODE TO 4 
25 IER»4 

GO TO 20 
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C SET ERROR CODE TO 2 

30 TER=2 
GO TO 20 

32 IF(N-36> 35/35,30 
35 NX=H 
HXX=N+i 
H2 = l 
KJ 1 = N+1 
DO 40 L = i /KJ 1 
«T*KJl-L+i 
40 C0F( MT >=XC0F(L) 

C SET INITIAL VALUES 
C 

45 X0«. 00500101 

Y0=0 .01000101 

C ZERO INITIAL VALUES COUNTER 

C 

IN = 0 
50 X=X0 

IHCREHENT INITIAL VALUES AND COUNTER 

X0=-10 . 0*Y0 
Y0=-10 . 0*X 

SET X AND Y TO CURRENT VALUE 

X = XO 

Y = YO 
IH = IN+ 1 
GO TO 59 

55 IFIT=1 
XPR = X 
YPR=Y 

EVALUATE POLYNOMIAL AND DERIVATIVES 

59 ICT=0 

60 UX=0.0 
UY=0 .0 

V = 0 . 0 
YT=0 . 0 
XT = 1 .0 
U=COF( N+i > 

IF(U > 65/ 130,65 

65 DO 70 I=l/N 
L=H-1+1 
TEMP=COF( L ) 

XT2=X*XT-Y*YT 
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YT2*X*YT+Y*XT 
U»U+TEMP*XT2 
V»V+TE«P*YT2 
FI = I 

UX*OX+FI*XT*TENP 
UY»UY-FI*YT*TEHP 
XT»XT2 
70 YT»YT2 

SUMSQ>:UX4>UX + UY*UY 
IF(SUHSQ> 7S.110i7S 
75 0X»< V*UY-U*UX)/SUMSQ 

X>X^DX 

0Y*-<U*UY+V*UX )/SUHSfl 
Y»Y+DY 

78 IF<DABS(DY> + DABS(DX >'-1 .00-05) 100,80,80 

STEP ITERATION COUNTER 

80 ICT=ICT+I 

IF<ICT-500) 60,85,85 
85 IF< IFIT )£00, 90, 100 
90 IF<IN-5> 50,95,95 

SET ERROR CODE TO 3 

95 IER»3 

GO TO 20 

100 DO 105 L*1,NXX 
MT=KJ1-L+1 
TENP = XCOF<NT ) 

XCOFCNT ) = COF<L ) 

105 COF(L)=TENP 
ITENP=N 
N = NX 

NX*ITEMP 

IF(IFIT) 120,55,120 
110 IF<IFIT> 115,50,115 
115 X=XPR 
Y*YPR 

120 IFIT=0 

122 IF(DA6S( Y )-l .00-4*DABS<X>) 135, 125,125 
125 ALPHA=X+X 

SUnS8=X*X+Y*Y 
N = H-2 
GO TO 140 
130 X = 0.0 

NX*NX-1 
135 Y = 0.0 

SUHSQ-0.0 

ALPHA=X 
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140 C0F<2)«C0F<2)+ALPHA*C0F< 1) 

145 DO 150 L«i/H , 

150 C0F(L-»1 >»C0F<L + 1 )+ALP«A*COF< L)-SUMSQ*COF( L-1 > 

155 R00TI(H2)>Y 

R00TR(H2)*X \ 

N2-H2+1 

IF<SUNSQ> 1«0<16S.160 
160 Y»-Y 

SUHS0*0.0 
GO TO 155 

165 IF(H> 20.20.45 
END 
EMDf 
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